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Abstract 


Thv^  Inverted  Echo  Sounder  (lES)  is  an  instrument  that  acoustically  monitors  the 
depth  of  the  main  thermocline  from  a  moored  position  one  meter  above  the  ocean  floor. 
Additionally,  the  lESs  can  be  equipped  to  measure  both  pressure  and  temperature.  The 
standard  steps  for  processing  lES  data  are  documented  here.  The  effect  and  purpose  of 
each  step  are  discussed  followed  by  a  description  of  how  to  apply  the  computer  programs 
that  constitute  the  step.  The  FORTRAN  and  MATLAB  codes  are  also  supplied. 
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1  Overview  of  lES  Processing 


The  lES  is  an  instrument  that  acoustically  monitors  the  depth  of  the  main  thermodine  from  a 
moored  position  one  meter  above  the  ocean  floor  (Chaplin  and  Watts  1981).  IFiS.s  are  t>]Me,illv 
configured  to  emit  a  set  of  twenty-four  consecutive  10  KHz  pings  at  10  sec  intervals  ever\  half  In.iir 
The  time  required  for  each  ping  to  reach  the  surface  and  return  is  reeorded  on  a  digital  cass.-tte  tape 
within  the  instrument.  If  an  IhS  also  mea.sures  bottom  pressure  and  temperature  (a  PIKS),  these 
quantities  are  also  written  to  tape. 

All  processing  steps  have  been  done  on  NficroV.AX  II  and  Micro\'.\X  III  computers  The  liata  are 
processed  with  a  series  of  FORTR.\.N'  and  MATLAB  routines  specifirallv  developed  for  the  IT,:). 
steps  are  outlined  below  and  schematically  illustrated  in  Figure  2. Figures  1  and  3  illustrate  the  more 


Major  Frocessine  Steps 
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Figure  1:  An  lES  subrecord  is  plotted  at  several  processing  stages  to  illustrate  some  of  the  major 
steps.  The  upper  panel  is  the  time  series  of  the  individual  r's  in  seconds.  Storms  often  result  in 
periods  of  high  scatter  or  a  lack  of  returning  echoes.  The  second  plot  shows  the  time  series  after  a 
single  representative  r  is  found  for  each  burst  of  r’.s  .  The  spikes  are  easily  identified  and  removed, 
and  the  tidal  signal  reduced  (third  plot).  The  final  plot  is  the  thermodine  depth  as  represented  by 
T  calibrated  to  Zn  (in  meters). 


visibly  noticeable  steps  for  travel  time  (r  )  and  pressure.  With  exception  of  SDR  and  BUNS,  which 
are  VAX  specific,  all  programs  use  standard  code  and  could  be  run  in  other  computing  environments. 
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Figure  2:  lES  Data  Processing  Flowchart 


S»immary  of  Steps 


RAW  DATA  CASSETTES  :  The  cassette,  which  is  recorded  within  the  lES,  contains  the  counts 
associated  with  travel  time,  pressure,  and  temperature  meas>irements  as  a  series  of  integer 
words  of  varying  lengths, 

SDR  :  This  program  controls  the  Sea  Data  Reader,  which  transfers  the  data  from  ca.ssettes  directly 
to  unformatted  binary  files  on  the  Micro\',\X. 

BUNS  :  Here  the  series  of  integer  words  of  varying  lengths  are  converted  to  standard  length  32-bit 
integer  words  and  are  written  to  ASCII  files, 

PUNS  :  Integer  listings  and  histograms  of  the  travel  times  are  generated  to  provide  an  initial 
look  at  data  quality  and  travel  time  distributions.  The  histogram  is  used  to  determine  the 
limits  for  maximum  and  minimum  acceptable  travel  times  for  an  initial  windowing  operation 
in  the  following  step.  The  listings  are  used  to  establish  the  first  (after  launch)  and  last  (before 
recovery)  'on  bottom'  samples  essential  for  determining  the  time  ba.se. 

MEMOD  :  .At  this  stage,  the  time  ba.se  is  established  and.  after  several  windowing  oper.ations,  a 
single  representative  r  is  estimated  from  the  burst  of  r's.  Travel  time,  pressure  and  temperature 
counts  are  converted  to  tinits  of  seconds,  decibars,  and  “C  respectively. 

FILL  :  Proper  incrementation  of  the  time  ba.se  is  enforced  here.  Missing  samples  are  inserted  using 
interpolated  values.  For  PIESs,  the  temperature  and  the  pressure  are  each  written  to  separate 
files  with  the  appropriate  time  ba.ses. 

DETIDE  ;  From  user-supplied  tidal  constituents  (specific  to  each  site),  the  tidal  contribution  to 
the  travel  time  is  estimated  and  removed. 

DESPIKE  •.  It  present,  spikes  are  identified  and  replaced  with  interpolated  values. 

SEACOR  :  The  effects  on  travel  time  from  seasonal  warming  and  cooling  of  the  surface  layers  ^re 
removed. 

RESPO  :  The  tides  are  removed  from  the  pressure  records  using  Response  Analysis  (Munk  and 
Cartwright,  1977). 

DEDRIFT  :  If  present,  long-term  drift  in  pressure  is  estimated  and  removed.  Drifts  are  typically 
associated  with  variation  in  the  properties  of  the  sensor  crystal  over  long  time-scales  or  slight 
imperfection  in  the  lES  master  clock. 

LOW-PASS  FILTERING  :  A  2nd-order  40-hr  low-pass  Butterworth  filter  is  applied  forward 
and  backwards.  The  smoothed  .series  are  subsampled  at  six  hour  intervals  centered  on  OOOOZ, 
0600Z,  1200Z,  and  1800Z  (UT).  During  this  step,  travel  time  is  calibrated  to  Zio- 


Travel  Time 

Variations  in  the  travel  times  have  been  shown  to  be  proportional  to  variations  in  the  thermocline 
depth  in  the  Gulf  Stream  region  (Watts  and  Rossby,  1977).  For  practical  purposes  the  main  ther¬ 
mocline  depth  can  be  represented  by  the  depth  of  the  12°C  isotherm  (Z12)  as  it  is  sitiiated  near 
the  highest  temperature  gradient  of  the  main  thermocline  and  correlates  well  with  r  (Rossby,  1969; 
Watts  and  Johns,  1982). 

In  previous  studies,  Z12  was  ob*ained  directly  from  the  XRT  cast.  However,  a  new  method  has 
been  developed  which  takes  advantage  of  the  integrative  nature  of  the  travel  time  measurement 
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lo  give  a  more  representative  measure  of  the  thermocline  depth.  The  new  measure.  Z*-,.  is  less 
susceptible  to  small  vertical-scale  perturbations  (i.e.,  internal  w>ves)  in  the  water  column  than  the 
single-point  measurement,  Zi2-  This  method  consists  of  calculating  Q,  the  'heat  content’  (/o’^’nln  Td:) 
for  each  calibration  XBT  cast;  then  using  Q  to  determine  Z*,  from  an  empirical  curve  relating  Z12 
and  Q.  The  curve  was  established  using  over  oOOO  XBT  casts  in  the  Gulf  Stream  region  (from 
NODC  archives). 

At  each  lES  site,  XBTs  are  taken  in  order  to  determine  the  lES's  calibration  coefficient  (R) 
necessary  to  convert  travel  time  into  thermocline  depth  according  to  the  relation:  Zfo  =  Mr-i-B.  The 
proportionality  constant  (M)  was  determined  from  regressions  of  all  calibration  pairs  (Z’o.  t)  from 
1987  to  1990.  The  regressions  showed  that  the  constant  value  M=-19.800  m/sec  was  appropriate 
for  all  the  lESs  in  the  Gulf  Stream  region.  (Hereafter  Z12  is  synonymous  with  Z*^] 

The  low-pass  filtered  travel  time  records  are  scaled  to  the  thermocline  depths.  Since  r  is  resolved 
to  0.1  msec,  Z12  is  therefore  resolved  to  ±2  m.  However,  the  accuracy  of  the  offset  parameter  R  is 
estimated  to  be  ±19  m  for  most  records  (judged  from  the  agreements  between  the  calibration  XRTs 
taken  at  each  site). 


Temperature 

The  thermistor's  main  purpose  is  to  correct  the  pressure  values  for  the  temperature  sensitivity  of 
^iansduc>-r.  TLv  i,licrrr.istOi  I-  ii'jiJc  th**  instrument,  on  the  pressure  transducer,  rather  than 
in  ihe  water.  However,  it  provides  accurate  bottom  temperature  measurements  once  the  probe  has 
reached  equilibrium  with  the  surrounding  water.  (The  measured  bottom-temperature  fluctuations 
are  effectively  low-pass  filtered  with  a  two-to-four  hour  e-folding  equilibrium  time).  The  first  24 
half-hourly  points  are  dropped  pri^ji  to  filtering,  ^in'r  tb'»  *or^p-r->tiTp  takes  twelve  hours  to  reach 
equilibrium  within  0.001‘’C  I  lie  accuracy  of  the  temperature  measurements  is  about  0.1°C.  and  the 
resolution  is  0.0002‘’C. 


Bottom  Pressure 

Digiquartz  pressure  sensors  manufactured  by  Paroscientific  Incorporated  are  used  to  measure  bottom 
pressure.  All  pressure  measurements  are  corrected  for  the  temperature  sensitivity  of  the  transducer. 
The  measured  bottom  pressure  is  dominated  by  the  tide;  however,  for  some  of  the  instruments, 
the  pressure  also  drifts,  0(0.1  dbar  yr“'),  monotonically  with  time.  Processing  of  the  pressure 
measurements  includes  removing  the  long-term  drift  and  tides.  Figure  3  illustrates  the  detiding  and 
filtering  of  a  pressure  subrecord. 

Response  Analysis  (Munk  and  Cartwright,  1977)  is  used  to  determine  the  tidal  pressure  signal 
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Figure  3:  The  detiding  and  filtering  of  a  pressure  are  illustrated  above  Pressure  is  offset  by  its 
mean  for  the  entire  record  of  4552  dbars. 


1  h<'  proilii-tril  art'  tlu  n  ri'iiiovoti  from  tlii'  pressure  reroriis. 

The  (uessure  rerortJs  are  detfriftt'iJ  in  (he  manner  developed  by  Wads  and  Kon(. lyiannis  (  I  t  'i  « 
who  have  I'xamiiied  pressure  sensor  lirift  ami  performance.  The  rati'  of  lirift  dera\s  with  lime  in  I 
IS  ill's!  .ijii'ro.ximateil  by  an  exponential  function  of  the  form’. 

Dr, ft  -  +  B 

\  iiesig;n  matrix  for  the  nonlinear  le,a.st-si]uares  fit  would  lie  composed  of  (c'’’'.  1)  1  li'-  ..m  tI. 
termmed  set  of  equations  is  solved  for  coefficients  .-1  and  B  These  coetficienls  are  f.sim'i  siil  je  i 
to  flit'  miniitu/'Ht  if^ii  nf  tho  rrns  *^rror  of  thf^  fit  a  function  of  l(i<'  *lcra\  rat*’,  A  M  ItUIIll/  t!  p  T1  1- 
acromplislied  using  the  method  of  paraliolic  extrapolation  and  golden  st'ctions  i  i’ress  et  al  ,  I'.is'i  t  - 
optimally  search  for  A  with  a  minimum  of  function  evaluations  (fits)  The  first  12  hours  of  pre>Mire 
are  ignored  since  the  t'rystal's  temperature  equililirates  during  that  period.  Idle  drift  curve-  ar'^ 
usually  found  from  t wolioiirly  sulisam|iled  records  for  computational  simplicity  .At  a  later  stage 
comparison  of  geostrophic  currents  (calculated  from  adjacent  dedrifted  pressure  sensors)  atid  tiearbv 
current  meters  will  be  used  to  verify  the  dedrift  procedtire’s  success. 

1  he  half-hourly  pressures  are  resolved  to  0.001  dbar  and  the  mean  pressure  is  accurate  to  wiihm 
i . a  dbar. 
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^Igure  4;  The  residual  pressure  before  and  after  the  subtraction  of  the  estimated  drift  (dashed). 


^When  ju»lifird,  a  lin<“ar  t<*rm  is  included. 


2  PROGRAM  DESCRIPTIONS 


2.1  SDR 

SnR  ahhreviatps  Sea  Data  Reader.  SDR  is  a  program  that  mstrurt.s  a  Sea  Data  model lieader 
to  read  a  four-track  cassette  tape  from  an  IKS  and  transcribe  the  jihase-encoded  data  into  a  binarv 
data  fde  (on  the  Micro\'ax  machine).  At  the  end  of  a  read  (signaled  by  entering  '<ctrl>  z'  from  the 
keyboard),  SDR  provides  statistics  of  the  read;  the  accnmuiated  number  of  good  and  bad  records, 
the  number  of  occurrences  of  each  of  the  different  error  conditions,  and  the  distribution  of  the  parity 
errors  across  the  four  tracks. 

Tlie  output  file  is  composed  of  unformatted  blocks  of  512  bytes  organized  into  worils  (2  bytes) 
Kach  word  ha.s  the  format  displayed  in  fable  1. 

Talde  1:  The  SDR  word  format  depends  on  the  type  of  word.  Bit  15  indicates  whether  the  word 
is  a  data  or  message  word.  Here  PE'  stands  for  parity  error,  cpr'  stands  for  the  number  of  1-bit 
characters  per  record,  and  low=0,  hi  =  l. 


low  indicates  a  PE 
low  indicates  a  PE 
low  indicates  a  PE 
low  indicates  a  PE 

hi  if  low  signal  occurred 
hi  if  short  record  occurred 
hi  if  PE  occurred 

hi  indicates  last  data  word  of  record 
hi  after  28  consecutive  data-free  words 
1st)  of  cpr 
msb  of  cpr 

hi  if  scans  were  missed 
hi  if  message  word 


bit 

description 

data  word  message  word 

0 

data  line  0  PE  track  1 

1 

data  line  1  PE  track  2 

2 

data  line  2  PE  track  3 

3 

data  line  3  PE  track  4 

1 

data  line  4 

5 

data  line  5  low  signal 

6 

data  line  6  short  record 

( 

data  line  7  parity  error 

8 

last  character 

9 

file  gap 

10 

word  length  (Isb) 

11 

word  length  (msb) 

12 

13 

14 

overrun 

15 

word  type 

To  run  SDR  a  user  must  have  PFNMAP  and  CMKRNL  process  privileges  (on  the  \'MS  oper¬ 
ating  system).  The  DCL  command  “d«fine  SDR  :  ==$8dr .  «*•”  allows  SDR. FOR  to  be  run  with 
qualifiers.  These  qualifiers  can  only  be  entered  from  the  command  line.  In  the  following  example, 
the  call  “SDR  /?”  displays  the  possible  qualifiers  (note  RWATTS}  is  the  system  prompt); 

RWATTS  }  sdr/? 

SDR  XI. 05  SEADATA  Tape  Reader  Data  Dump  Program 

Nay  19  1988  18:28:28 

usage:  SDR  (filename)  (svitches) 

Svitchea : 

/B  -  Buffer  numbers  displayed 
/Cn  -  Ch2uractei3  per  record 
/D  -  Debug  mode 
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/I  -  lo  statistics  generated 

/P  -  Prompt  for  device  characteristics 

Switches  must  be  separated  by  spaces. 

RWATTS  } 

If  no  qualifiers  are  used  SDR  will  prompt  for  the  number  of  four-bit  characters  per  record  (ex¬ 
cluding  preamble  and  longitudinal  check  characters,  LCC).  The  number  of  characters  per  record  is 
the  same  as  was  wired  on  the  control  card  in  the  lES’s  recorder. 

The  cas.sette  reader  must  be  set  properly  for  data  to  be  read  with  a  minimum  of  errors. 


SWITCH 

SETTING 

mode 

counter 

density 

800  bpi 

control 

local 

output 

computer 

speed 

7.5  ips 

data 

data 

The  MASTER  GAIN  should  be  set  about  60  and  the  THRESHOLD  to  20%.  The  TRACK  GAIN 
ADJUST  knobs  should  point  to  about  2  o'clock.  With  the  METER  MONITOR  switch  set  to  VCO 
the  meter's  needle  should  point  to  100%. 

The  amplifier  gain  must  be  checked  for  each  of  the  four  channels.  In  order  to  have  a  calibrated 
flux  detection  threshold,  the  signal  levels  for  each  channel  should  be  situated  between  100%  and 
120%  when  a  cassette  is  being  read.  The  signal  levels  of  the  individual  channels  are  checked  by 
switching  the  METER  MONITOR  switch  from  VCO  to  each  of  the  four  channel  numbers.  All 
channels  are  adjusted  simultaneously  with  the  MASTER  GAIN  control,  and  individual  channels 
may  be  adjusted  using  the  corresponding  TRACK  GAIN  ADJ  potentiometer  for  that  channel. 

Several  readings  should  be  made  of  a  cassette’s  contents  and  the  one  with  the  least  errors  selected 
for  further  processing.  Below  an  example  of  a  read  session  is  listed.  The  first  command  defines  the 
symbol  SDR,  which  runs  the  program.  The  program  prompts  for  the  number  of  4-bit  characters  per 
record  and  a  file  prefix  to  be  added  to  the  extension  *.sdr’  for  naming  the  binary  output  file.  When 
the  tape  is  not  being  read  or  when  the  final  file  gap  is  reached  the  message  ‘/,SDR-I-IODXTA ,  Ho 
data  is  being  received  fro«  the  reader  is  displayed.  The  entry  <ctrl>Z  closes  the  output  file 
and  displays  the  statistics  on  the  screen.  Of  the  two  readings  below,  the  second  has  more  ‘good  " 
records,  fewer  parity  errors,  and  fewer  overruns  flags. 

RWATTS  }  edr  :==$rwatts$duaO: Ccruise.8drladr.exe 
RMATTS  >  edr 

SDR  XI. 05  SEAOATA  Tape  Reader  Data  Duap  Program 

Nay  19  1988  18:28:28 

I/C  section  mapped  75800  to  759FF. 

Characters  per  record?  86 
Data  file  name  <.SDR>?  sdr.test 
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Logging  data  to  file  RWATTS$DUAO: [CRUISE. SDR] SDR.TEST. SDR; 1 
y.SDR-I-VODATA,  lo  data  is  b«ing  rscaived  from  the  reader. 
y.SDR-I-HODATA ,  lo  data  is  being  received  from  the  reader. 

*Z 

Data  file  RWATTS$DUAO : [CRUISE . SDR] SDR.TEST . SDR; 1  closed. 

Records  -  Good:  15577  (99,1’/.)  Bad:  135  (0.9*/,)  Total:  15712 

Messages:  15717  File  Gaps:  3  Overruns:  117  Paurity  Errors:  4 

Paurity  Errors  - 

Track  1 :  3 

Track  2:  4 

Track  3:  3 

Track  4:  2 

RWATTS  } 

RWATTS  >  sdr 

SDR  XI. 05  SEADATA  Tape  Reader  Data  Dump  Program 

May  19  1988  18:28:28 

I/O  section  mapped  75800  to  759FF. 

Characters  per  record?  86 

Data  file  name  <.SDR>?  sdr_test_run2 

Logging  data  to  file  RWATTSSDUAO: [CRUISE. SDR] SDR_TEST_RUI2. SDR; 1 
y.SDR-I-NODATA,  lo  data  is  being  received  from  the  reader. 


Z 


Data  file  RWATTSSDUAO: [CRUISE. SDR] SDR_TEST_RUI2. SDR; 1  closed. 


Records  -  Good:  15592  (99.2%) 

Messages:  15716  File  Gaps:  3 

Parity  Errors  - 

Track  1:  3 

Track  2:  3 

Track  3 :  3 

Track  4 :  1 


Bad:  120  (0.8%)  Total:  15712 
Oveiruns:  115  P2u:ity  Errors:  3 
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2.2  BUNS_AUG89.FOR  and  BUNS_ENGIN_AUG89.FOR 

The  purpose  of  this  program  is  to  create  standard  length  words  from  a  series  of  integer  words  of 
varying  lengths.  The  input  is  a  string  of  several  ‘N’  bit  words,  where  N  ranges  between  1  and  31. 
The  output  is  a  series  of  32-bit  computer  words,  which  contain  the  ’N"  bit  string  of  each  word  in  the 
least  significant  position.  Padding  to  the  left  with  zeros  is  done  wherever  necessary.  The  length  N 
of  each  w’ord  to  be  ‘decoded’  is  supplied  by  the  user  and  is  contained  in  a  control  file. 

The  input  bit  strings  are  read  from  a  file  created  by  SDR.  Although  the  ba.sic  procedures  used 
in  this  program  could  decode  any  string  of  bits,  there  are  a  few  statements  which  make  it  specific  to 
be  run  on  a  microVAX  with  a  file  created  by  SDR.  The  output  is  written,  one  sampling  period  at  a 
time,  to  a  disk  file.  The  user  specifies  the  output  format,  either  binary  or  1319,  in  the  control  file. 

The  FORTRAN  source  code  is  listed  in  Section  3.1.  The  user  supplied  parameters  are  described 
in  detail  below  and  two  example  control  files  follow. 

CONTROL  FILE 

This  file  is  composed  of  a  series  of  parameter  lines  which  are  identical  in  format  ( A2.3X,10I.5).  Each 
line  is  composed  of  a  character  string,  IDI,  and  an  integer  array.  IV'ALS. 

IDI,  (IVALS(I),I=1,10) 

where: 

IDI  -  {CnARACTER*2)  IDI  is  a  string  that  identifies  the  type  of  parameters  which  follow  in  the 
array  IV’ALS.  IDI  has  pos-sible  values  of  ‘NW’,  ‘WL’,  ‘SV’,  ‘US’,  and  ‘\VF’,  which  stand  for 
‘number  of  words’,  ‘word  length’,  ‘special  value’,  ‘unspan’,  and  ‘write  format’. 

rVALS(lO)  -  (INTEGER*4)  IVALS  contains  input  parameters  of  type  specified  by  IDI.  The  mean¬ 
ing  of  each  element  of  the  array  is  explained  below. 


Parameters  in  the  Control  File 

if  IDI=‘NW’ 

IDI  =  ‘NW’  this  indicated  that  a  ‘number  of  words’  array  follows.  This  ‘NW’  group  indicates  the 
number  of  integer  words  pertaining  to  one  sampling  period  which  are  to  be  decoded. 

rVALS(l)  =  NWDS  Total  number  of  non-negative,  non-zero  words  listed  on  the  ‘WL’  lines. 

rVALS(2)  =  NSECT  The  number  of  cassette  records  needed  to  hold  all  the  data  from  one  sam¬ 
pling  period.  This  should  be  equal  to  the  number  of  -1  values  on  the  ‘W'L’  lines. 


If  IDI  =  ‘WL’ 

IDI=‘WL’  ‘WL’  denotes  a  ‘word  length’  array,  which  gives  the  length  in  bits  of  each  word  to  be 
decoded  into  a  32-bit  word.  Typically,  several  ‘WL’  lines  are  required  specify  all  the  word 
lengths. 
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IVALS(l-lO)  =  DECODE(l-lO)  Array  of  word  lengths  to  be  decoded.  All  zero  values  are  ig¬ 
nored.  The  end  of  the  cassette  record  is  flagged  by  -1. 


If  IDI  =  ^SV’ 

IDI  =  ‘SV’  ‘SV’  denotes  a  'special  value’  array.  This  array  signals  that  some  of  the  words  are 
expected  to  have  specific  values. 

IVALS{I)  =  TESTW  The  word  number  which  is  to  be  tested  for  a  specific  value. 

IVALS(I-l-l)  =  TESTV  The  value  that  TESTW  is  expected  to  have.  It  is  ignored  if  its  value  is 
either  negative  or  zero. 


If  IDI  =  ‘US’ 

IDI  =  ‘US’  this  is  the  ‘unspan’  array.  This  indicates  that  the  bits  associated  with  a  single  data 
value  actually  span  two  cassette  records  and  these  need  to  be  joined  to  form  a  single  32-bit 
word. 

IVALS(l)  =  ITHROT  If  it  is  less  than  or  equal  to  zero,  all  words  will  be  processed.  If  greater 
than  zero,  the  corresponding  word  will  not  to  be  converted  to  a  32-bit  word  and  its  value  will 
be  lost. 

IVALS(I),  IVALS(I+1)  ;  where  I  >  1.  This  pair  of  words  are  to  be  unspanned.  The  bits  stored 
in  IVALS(I)  are  of  higher  order  than  those  in  IVALS(I-t-l).  If  the  value  of  these  are  zero,  they 
are  ignored. 


If  IDI  =  ‘WF’ 

IDI  =  ‘WF’  this  is  the  ‘write  format’  line.  This  is  used  to  determine  the  format  of  the  output 
data  file. 

IVALS(l)  =  KWIFMT  If  =  0,  output  is  binary.  If  =  1.  output  will  have  the  format  (1319). 

EXAMPLE  CONTROL  FILES 

Two  examples  of  control  files  are  listed  in  Table  2.  The  first  one,  MOD.92CPR.CTRL,  is  relatively 
simple  with  one  cassette  record  corresponding  to  one  sample  period.  Thus  there  are  no  words 
which  need  to  be  unspanned.  It  is  used  with  lESs  which  have  92  4-bit  data  characters  (368  bits) 
recorded  on  each  cassette  record.  In  this  example,  the  data  included  in  the  368  bits  are  one  16-bit 
sequence  number  word,  twenty-four  13-bit  travel  time  words,  one  24-bit  pressure  word,  and  one 
16-bit  temperature  word.  The  output  data  set  will  be  written  in  binary  format. 

The  second  one,  MOD-82CPR.CTRL,  is  more  complex  with  the  data  from  one  sampling  period 
spanning  three  cassette  records.  The  ‘SV’  card  indicates  that  there  are  three  words  which  are 
expected  to  have  specific  values:  Word  1  is  expected  to  be  zero.  Words  24  and  48  are  both  expected 
to  contain  the  value  1.  The  ‘US’  card  indicates  that  the  very  first  word  is  not  to  be  converted  to  a 
32-bit  word,  and  its  contents  will  not  be  saved  in  the  output  data  set.  Additionally,  the  11  bits  of 
word  23  and  the  7  bits  of  word  25  are  to  be  combined  to  form  a  single  data  word  that  will  be  18  bits 
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Table  2:  Two  examples  of  control  files  for 
MOD-92CPR.CTRL 


NV 

27 

01 

WL 

IS 

13 

13 

13 

13 

WL 

13 

13 

13 

13 

13 

UL 

13 

13 

13 

13 

13 

SV  0 

US  0 

WF  0 

MOD.82CPR.CTRL 


HV 

70 

03 

WL 

1 

16 

18 

12 

18 

WL 

18 

12 

18 

12 

18 

WL 

18 

12 

11 

-1 

0 

WL 

1 

7 

12 

18 

12 

WL 

12 

18 

12 

18 

12 

WL 

12 

18 

12 

8 

-1 

WL 

1 

10 

12 

18 

12 

WL 

12 

18 

12 

18 

12 

WL 

12 

18 

12 

5 

-1 

SV 

1 

0 

24 

1 

48 

US 

1 

23 

25 

47 

49 

WF 

1 

JN'S-AUG89.FOR,  See  text  for  explanations. 


13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

24 

16 

-1 

12 

18 

12 

18 

12 

12 

18 

12 

18 

12 

0 

0 

0 

0 

0 

18 

12 

18 

12 

18 

18 

12 

18 

12 

18 

0 

0 

0 

0 

0 

18 

12 

18 

12 

00 

18 

12 

18 

12 

18 

0 

0 

0 

0 

0 

1 

0 

0 

0 

0 

0 

0 

0 

0 

0 

long;  the  bits  of  word  23  will  be  in  the  most  significant  positions.  This  new  18-bit  word  will  then 
be  packed  into  a  standard  32-bit  word.  The  same  procedure  will  be  repeated  for  the  8  bits  of  word 
47  and  the  10  bits  of  word  49.  The  output  data  set  will  be  in  (1319)  format. 


2.3  PUNS_MAY88.FOR 


This  program  produces  histograms  and/or  listings  of  the  travel  time  (r)  bursts  within  a  specified 
range  of  sampling  periods.  This  program  was  developed  to  give  the  user  a  first  look  at  the  distribution 
of  the  T  counts,  within  a  single  sampling  period  or  for  several  sampling  periods,  before  any  further 
processing  is  done.  Typically,  the  histograms  are  used  to  determine  the  acceptable  range  of  ‘good’  r 
counts  to  eliminate  early  and/or  late  echo  returns  from  being  used  during  the  subsequent  processing 
steps.  The  listings  are  used  to  establish  the  time  base  by  determining  the  actual  ‘on  bottom’  sampling 
periods, 

PUNS  is  applied  to  the  data  set  produced  by  BUNS.  The  user  specifies  the  types  of  output 
desired  in  a  control  file.  As  the  BUNS  data  is  read,  each  sampling  period  is  counted  consecutively. 
These  ‘record  numbers’  are  used  for  specifying  the  samples  which  are  to  be  plotted  or  listed. 

Three  types  of  histograms  can  be  produced:  (1)  Level-1  (LI  option)  produces  one  histogram  for 
each  sampling  period  within  the  range  of  record  numbers  specified  by  the  user  (START  and  END). 
(2)  Level-2  (L2  option)  produces  a  histogram  for  a  group  of  sampling  periods  (GRPSIZ).  Several 
records  can  be  skipped  (RATE)  between  subsequent  groups  to  be  plotted.  These  are  repeated 
until  all  records  between  START  and  END  have  either  been  processed  or  skipped.  (3)  Level-3 
produces  a  histogram  of  all  processed  records  between  START  and  END.  This  histogram  is  produced 
automatically  every  time  the  program  is  executed;  that  is,  it  is  not  a  user-controlled  option.  To  select 
either  a  level-1  or  level-2  histogram,  the  user  specifies  ‘LI’  or  ‘L2’  in  the  name  list  group  called 
CARDS  in  the  control  file.  The  bin  sizes  of  the  histograms  are  determined  within  the  program  from 
the  range  of  r  counts  specified  by  the  user.  Maximum  and  minimum  counts  (UBNDA  and  LBNDA, 
respectively)  are  supplied  within  the  name  list  group  CARD6  of  the  control  file.  A  wide  range  can 
be  selected  to  obtain  a  histogram  of  all  r  counts  or  narrow  one  can  be  chosen  to  enlarge  a  portion 
of  the  count  range.  If  the  lES  has  two  echo  detectors,  separate  histograms  are  produced  for  the  r’s 
from  each  detector.  The  user  must  specify  the  range  of  r  counts  for  both  echo  detectors  for  these 
histograms. 

The  listings  of  the  travel  times  are  either  of  integer  counts  (‘IN’  option)  or  their  decimal  equiv¬ 
alents  (‘DE’  option).  The  user  specifies  either  ‘IN’  or  ‘DE’  within  CARDS  of  the  control  file  to 
select  the  desired  output.  The  decimal  equivalents  are  calculated  by  scaling  the  integer  counts  by 
the  factors  SFl  and  SF2  supplied  by  the  user  in  CARDS  of  the  control  file.  If  there  are  additional 
sensors,  such  as  pressure,  their  values  are  given  only  as  integer  counts  on  both  types  of  listings.  The 
listings  give  the  consecutive  record  number,  sequence  number,  and  the  data  values  for  each  sampling 
period  between  START  and  END.  A  level-3  histogram  will  be  produced  for  all  records  listed. 

The  FORTRAN  source  code  is  listed  in  Section  3.2.  The  user  supplied  name  lists  are  listed  in 


detail  below. 
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Control  File 

The  control  file  is  made  up  of  eight  name  list  groups,  names  CARDl  -  CARDS.  These  are  all  in 
free  format. 

CARDl 

HEADR  -  (CHARACTER*60)  Alphanumeric  array  containing  comment  information.  Usually 
used  to  identify  the  instrument  site  and  serial  number. 

CARD2 

NTT  -  (INTEGER*!)  Number  of  travel  time  echo  detectors  on  the  lES. 

TTYPE(2)  -  {CHARACTER*3)  Alphanumeric  names  used  to  designate  the  types  of  echo  detec¬ 
tors  used. 


CARD3 

NWORDS  -  (INTEGER*!)  Number  of  words  as.sociated  with  each  sampling  period. 

LBURST  -  NTEGER*!)  Number  of  r’s  measured  during  a  single  sampling  period. 

LBFST  -  (INTEGER*!)  Word  number  associated  with  the  first  r  of  the  burst.  Typically,  word  1 
is  the  sequence  number  and  the  burst  begins  in  word  2. 

RDFMT  -  (INTEGER*!)  Format  of  the  input  data.  If  0,  the  data  is  binary.  If  1,  the  data  is  in 
(1319)  format. 

CARD4 

NSEN  -  (INTEGER*!)  Number  of  sensors  in  addition  to  the  r  echo  detectors. 

SENSOR(3)  -  (CHARACTER*2)  Alphanumeric  name  for  the  type  of  sensor.  ‘PR’  is  for  pressure, 
‘TP’  for  temperature,  and  ‘AM’  for  ambient  noise. 

SWDNO(3)  -  (INTEGER*!)  Word  number  associated  with  the  sensor. 

CARDS 

SFl  -  (REAL*!)  Scaling  factor  for  the  first  r  echo  detector  used  to  convert  r  from  integer  counts 
to  time  in  decimal  seconds. 


SF2  -  (REAL*!)  Same  as  above,  except  for  the  second  r  echo  detector.  If  there  is  only  one  r 
detector,  this  variable  is  ignored. 
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CARD6 

LBNDA  -  (INTEGER’'‘4)  Lower  limit  of  the  histogram  of  counts  for  the  first  t  echo  detector. 

UBNDA  -  (1NTEGER*4)  Upper  limit  of  the  histogram  of  counts  for  the  first  r  echo  detector. 

LBNDB  -  (IN  1  EGER*4)  Same  as  LBNDA,  except  for  the  second  echo  detector.  This  variable  and 
UBNDB  are  ignored  if  there  is  only  one  t  detector. 

UBNDB  -  (INTEGER*4)  Same  as  UBNDA,  except  for  the  second  echo  detector. 

CARD7 

START  -  (INTEGER*4)  Record  number  associated  with  the  first  sampling  period  to  process. 
Counted  sequentially  from  the  beginning  of  the  input  data  set. 

END  -  (INTEGER*4)  Record  number  associated  with  the  last  samp!»  to  nroep-- 

RATE  -  (INTEGER*4)  Number  of  records  to  skip  between  the  groups  being  processed.  If  RATE 
>  0,  level-2  plots  are  generated. 

GRPSIZ  -  (INTEGER*4)  Number  of  records  to  be  included  in  one  histogram.  It  should  always 
be  greater  than  or  equal  to  one. 

SEQINC  -  (INTEGER*4)  Expected  increment  of  the  sequence  number  between  sampling  periods. 
In  the  lES,  this  increase  by  1  every  15  minutes.  Thus  for  a  30  minute  sampling  period,  SEQINC 
=  2. 

CARDS 

OPTN(4)  -  (CHARACTER*2)  Alphanumeric  codes  indicating  the  type  of  output  desired.  If  no 
options  are  selected,  only  a  level-3  histogram  will  be  produced.  Available  options  are: 

‘IN’  -  integer  listing  of  the  r  counts 
‘DE’  -  decimal  listing  of  the  r’s  in  seconds 
‘LI’  -  histogram  for  each  sampling  period 
‘L2’  -  histogram  of  groups  of  sampling  periods 
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2.4  MEMOD_JUL89.FOR 

The  main  objectives  of  MEMOD  are  to  to  establish  the  time  base  and  convert  the  travel  time  counts 
to  seconds.  If  the  instrument  is  a  PIES,  MEMOD  will  also  calibrate  pressure  and  temperature. 
The  inputs  are  the  BUNS  dataset  and  a  control  file.  On  output,  a  data  file  is  created  containing 
the  calibrated  measurements  with  their  corresponding  sample  times.  A  listing  file  is  also  created;  it 
contains  statistical  information  pertaining  to  the  travel  time  calculation. 

The  FORTRAN  source  code  is  given  in  Section  3.4.  The  user  supplied  control  file  is  described 
below. 

2.4.1  PROCESSING  OF  TRAVEL  TIME 

A  single  value  is  determined  that  suitably  represents  the  burst  of  ‘M’  travel  time  measurements 
(typically  M=24).  First,  the  ‘M’  pings  are  windowed  to  remove  unreliable  t’s.  Then  the  subroutine 
TTMODE  calculates  the  modal  r  based  on  the  assumption  that  the  r’s  are  members  of  a  Rayliegh- 
distributed  statistical  population.  Alternatively,  the  user  may  specify  that  the  median  r  of  the  burst 
be  selected  using  the  subroutine  TTMEDN. 

MEMOD  is  equipped  to  deal  with  lESs  with  one  or  two  echo  detectors.  The  measurements  from 
one  or  both  of  the  detectors  may  be  processed  in  a  single  execution  of  MEMOD.  The  user  specifies 
which  method  (median  or  mode)  is  to  be  used  and  with  which  detector  (TTl  and/or  TT2)  within 
the  control  file. 

To  indicate  to  MEMOD  that  the  travel  time  counter  overranged,  the  window  limits  (in  the 
control  file)  are  set  such  that  the  value  of  the  lower  limit  exceeds  the  upper  limit.  In  that  case,  the 
upper  limit  and  the  measured  r’s  are  recalculated  by  MEMOD  by  adding  the  appropriate  power  of 
two  number  of  counts  prior  to  windowing  the  r’s  . 

The  user  specifies  upper  and  lower  window  limits  in  CARD?  of  the  control  file.  If  all  the  r's  in 
the  burst  are  outside  the  specified  range  (either  all  greater  than  the  upper  limit,  or  all  less  than  the 
lower  limit),  the  ‘selected’  r  is  set  equal  to  the  limit  exceeded.  If  the  quartile  range  of  the  burst 
is  too  large,  the  25th  percentile  r  (based  on  empirical  evidence)  is  used  instead  of  the  median  or 
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modal  T  .  The  range,  r  ,  and  number  of  r's  from  the  burst  actually  used  in  the  selection  process 
are  written  to  the  listing  file. 

Another  windowing  operation  called  ‘Bin’  windowing  is  applied  within  \IE\I0D-JI'L89  at  the 
start  of  the  subroutine  TTMODE.  (The  code  can  be  modified  to  have  bin  windowing  within  the 
main  code  rather  than  in  the  subroutine.)  The  basic  idea  of  bin  windowing  is  that  the  direct  surface 
reflections  will  be  most  probable,  and  that  there  is  a  time  period  within  which  all  the  true  echos 
woidd  be  expected  to  occur.  This  method  divides  the  13-bit  range  of  8192  counts  into  64  equal 
intervals  (128  counts).  The  bin  containing  the  most  occurrences  is  likely  to  contain  the  single  most- 
representative  travel  time  of  the  burst.  The  bin  window  consists  of  this  most  abundant  bin  and  its 
two  closest  neighbors  and  has  a  range  of  3  128  =  384  counts.  Since  bursts  measured  by  a  “healthy" 
lES  typically  have  ranges  less  than  200  counts,  the  desired  signal  will  be  contained  within  this  bin 
window 

2.4.2  PROCESSING  OF  ADDITIONAL  SENSORS 

The  subroutine  TEMPRS  within  MEMOD  converts  temperature  anc  pressure  counts  to  physical 
units.  This  version  of  MEMOD  does  not  process  ambient  noise  measurements,  which  is  another 
optional  configuration  for  the  lES. 

Temperature  counts  are  converted  into  ®C  by  a  linear  expression.  Two  calibration  methods  are 
possible.  One  method  uses  an  ‘ideal’  equation;  the  other,  an  empirical  ‘lab’  equation.  The  choice 
of  method  is  made  in  CARD14.  With  the  present  lESs,  only  the  laboratory  calibration  should  be 
used  (specified  with  LAB=1  in  CARD14).  For  this  equation,  the  u.ser  supplies  two  calibration  pairs 
(temperature  and  counts)  in  the  namelist  (NML)  group  CARD14. 

The  bottom  pressure  is  a  function  of  both  the  pressure  counts  and  the  temperature.  The  cali¬ 
bration  equations  used  are  specific  to  the  Paroscientific  Inc.  sensors  used.  The  calibration  have  two 


possible  forms: 


P 


(1) 
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The  coefficients  A,  B,  C,  and  the  parameter  To  are  polynomial  functions  of  temperature;  D  is  a 
constant  coefficient;  and  T  is  the  measured  period  of  the  transducer  (the  counting  period  divided 
by  the  pressure  counts).  The  user  .specifies  which  of  the  equations  is  to  be  used  in  CARDIO  of  the 
control  file.  Whenever  possible,  it  is  preferable  to  use  Equation  1  instead  of  Equation  2. 

The  period,  T,  is  determined  from  the  pressure  counts  and  the  sampling  interval.  The  user 
specifies,  on  CARDIO  of  the  control  file,  whether  or  not  the  pressure  counter  has  overranged  at 
depth.  If  overranging  has  occurred,  2^"*  is  added  to  the  pressure  counts  prior  to  calculating  the 
period.  The  user  specifies  the  sampling  interval  length  (in  seconds)  in  CARD14  of  the  control  file.  If 
pressure  has  been  electronically  prescaled  within  the  lES  prior  to  recording,  this  sampling  interval 
must  be  adjusted  accordingly.  Currently,  the  frequency  output  of  the  pressure  sensor  is  divided  by 
four  before  being  counted,  thus  sampling  interval  specified  should  be  divided  by  four. 

The  temperature-dependent  coefficients  (A,  B,  C,  To)  need  to  be  recalculated  for  each  sampling 
period.  These  coefficients  have  quadratic  form  (To  may  occasionally  be  cubic),  and  they  are  unique 
for  each  transducer.  Calibration  coefficients  are  read  from  CARDll.  CARD12  and  CARD13. 

2.4.3  TIME  BASE 

The  exact  day  and  time  of  a  specific  first  ping  of  a  burst  serves  as  a  reference  from  which  all  other 
sample  times  are  determined.  This  time  is  specified  in  NML  group  CARD9.  Typically  the  time  of 
the  first  ping  of  the  ‘last-good-on-bottom’  burst  is  used. 

MEMOD  introduces  a  small  offset  to  the  reference  time  specified  in  CARD9,  so  that  it  corre¬ 
sponds  to  the  middle  of  the  burst,  rather  than  the  first  ping  of  the  burst.  (For  a  travel  time  burst 
consisting  of  24  pings  at  10  sec  intervals,  the  time  base  is  offset  115  sec.) 

MEMOD  and  all  further  processing  report  time  in  units  of  yearhours;  there  are  8760  hours  in 
a  non-leap  year.  Zero  yearhour  corresponds  to  January  1  at  0000  UT.  Thus  positive  yearhours 
correspond  to  sampling  periods  after  January  1;  negative  yearhours  refer  to  the  previous  calendar 


year. 


2.4.4  OUTPUT  DATA  SET 


On  output,  a  data  file  and  a  listing  file  are  created  for  each  echo  <letector.  The  output  data  files 
consist  of  five  variables  written  in  oE15.7  format.  In  order,  these  are  travel  time,  pressure,  temper¬ 
ature,  ambient  noise,  and  time  (in  units  of  seconds,  decibars,  ®C  ,  decibels,  and  yearhours).  For 
lESs  without  the  additional  sensors,  these  variables  contain  only  values  of  -!)9.00.  The  ambient  noise 
column  will  always  contain  -99.00,  since  no  processing  is  done  on  this  variable. 

CONTROL  FILE 

The  control  file  contains  9  NML  groups,  CARD1-CARD9,  plus  four  additional  groups  for  PIESs 
(CARDIO-CARDM).  .All  namelists  are  in  free  format. 

CARDl 

HE  ADR  -  (CH.ARACTER*60)  string  containing  comment  information.  Fsually  used  to  identify 
the  instrument  site  and  serial  number. 


CARD2 

NTT  -  (INTEGER*!)  Number  of  echo  detectors  on  the  lES. 

TTYPE(2)  -  (CII  ARACTER*3)  strings  used  to  designate  the  types  of  echo  detectors  used. 


CARD3 

NWORDS  -  (INTEGER*!)  .Number  of  words  associated  with  each  sampling  period. 

LBURST  -  (INTEGER*!)  .Number  of  r’s  mcastired  during  a  single  sampling  period. 

LBFST  -  (INTEGER*!)  Word  number  associated  with  the  first  r  of  the  burst.  Typically,  word  1 
is  the  sequence  number  and  the  burst  begins  in  word  2. 

RDFMT  -  (INTEGER*!)  Format  of  the  input  data.  If  0,  the  data  is  binary.  If  1.  the  data  is  in 
(1319)  format. 


CARD4 

NSEN  -  (INTEGER*!)  Number  of  sensors  in  addition  to  the  r  echo  detectors.  If  0,  CARDIO- 
CARD14  are  not  read  by  MEMOD. 

SENSOR(3)  -  (CHARACTER*2)  Character  string  name  for  the  type  of  sensor.  PR’  is  for  pres¬ 
sure,  ‘TP’  for  temperature,  and  ‘AM’  for  ambient  noise. 

SWDNO(3)  -  (INTEGER*!)  Array  containing  the  word  number  a.s.soriated  with  the  sensor  type. 
SVVDNO(i)  indicates  the  word  position  of  SENSOR(i). 


CARDS 

SFl  -  (REAL*!)  Scaling  factor  for  the  first  echo  detector  used  to  convert  r  from  integer  counts  to 
time  in  seconds. 


SF2  -  (REAL*!)  Same  as  above,  except  for  the  secoti  l  echo  <teti'<'tor.  If  NSEN  =  1.  tliis  variabl*- 
is  not  used. 

AMSF  -  {REAL*4)  Scaling  factor  used  to  convert  the  ambient  noise  counts  to  decibels.  T urrently, 
this  variable  is  not  used. 


CARDS 

NFIRST  -  (INTEGER*4)  Record  number  of  the  first  sampling  period  to  process  This  is  usually 
the  first  record  containing  ‘on  bottom’  measurements. 

NFSEQ  -  (INTEGER*!)  Sequence  number  a.s.sociated  with  the  NEIRST  record. 

NLAST  -  ( INTEG F’,R*4)  Record  number  of  the  last  sampling  period  to  process.  This  is  usually 
the  last  record  containing  ‘on  bottom’  measurements. 

NLSEQ  -  (INTEGER*!)  Sequence  number  associated  with  the  NLAST  record. 

SEQINC  -  (INTEGER*!)  Expected  increment  of  the  sequence  number  between  sampling  peri¬ 
ods.  In  the  lES.  this  increase  by  1  every  La  minutes.  Thus  for  a  .‘iO  minute  sampling  period. 
SEQINC  =  2. 


CARD7 

LBNDl  -  (INTEGER*!)  The  lower  bound  on  the  r  counts  for  the  first  echo  detector.  Counts  lower 
than  LBNDl  are  excluded  from  further  processing. 

UDNDl  -  (I.NTEGER*4)  The  upper  bound  on  the  r  counts  for  the  first  echo  rietector.  Counts 
greater  than  EBNDl  are  excluded  from  further  proces.sing. 

LBND2  -  (INTEGER*4)  Same  as  LBNTJl.  except  for  the  second  detector.  Not  used  if  NTT=1 

UBND2  -  (INTEGER*4)  Same  as  EBNDl.  except  for  the  secoml  detector  Not  used  if  NTT=1. 

DGRPHR  -  (REAL*8)  Number  of  sampling  periods  per  hour 

CARDS 

IOPT(6)  -  (CHAR  ACTER*4)  string  indicating  the  type  of  proces.sing  to  be  done.  Available  options 
are: 

TTl’  -  r  counts  of  the  first  echo  detector  are  to  be  proces.sed. 

‘MEDl"  -  Subroutine  TTMEDN  is  to  be  used  to  calculate  the  rtiedian  of  TTl  counts. 
‘MODI’  -  Subroutine  TTMODE  is  to  be  used  to  calculate  the  modal  value  of  th'‘  TTl  counts 
‘TT2’  -  Same  as  TTl,  except  for  the  second  detector. 

‘MED2’  -  Same  as  MEDl,  except  for  TT2. 

‘MOD2'  -  Same  as  MODI,  except  for  TT2. 

CARD9 

The  first  six  of  these  variables  specify  the  year,  month,  day,  hour,  minutes,  and  seconds  to  be 
associated  with  the  sampling  period  whose  sequence  number  is  contained  in,  ISEQO.  They  are  all 
supplied  as  two-digit  numbers.  The  program  asstimes  that  it  is  the  20th  century. 


lYR  -  (INTEGER*4) 


year 


MNTH  -  (INTEGER*4) 

month 

IDAY  -  (INTEGER*4) 

day 

IHOUR-  (INTEGER*4) 

hour 

MINUT  -  (INTEGER*4) 

minutes 

ISEC  -  (INTEGER*4) 

seconds 

ISEQO  -  (INTEGER*4) 

Sequence 

day  and  time  specified  by  the  preceeding  six  variables.  This  is  u.sed 
to  establish  the  time  b^ise. 


CARDIO 

EQN  -  (CHARACTER’^2)  The  equation  to  be  used  to  calculate  the  pressure  in  dbar  from  the 
number  of  counts.  The  options  are  ‘AB’  or  ‘CD’  corresponding  to  Equations  2  and  1. 

OVERNG  -  (CHARACTER*2)  Code  to  determine  whether  the  pressure  counts  have  overranged. 
Available  codes  are  ‘YE’  -  that  overranging  has  occurred,  and  'NO'  -  that  it  has  not  occurred. 


CARDll 

ACl  -  (REAL*8)  The  constant  in  quadratic  equation  used  to  calculate  the  temperature-dependent 
calibration  coefficient  A  (if  EQN  =  ‘AB’)  or  C  (if  EQN  =  ‘CD’). 

AC2  -  (REAL*8)  Same  as  ACl,  except  it  is  the  first  order  coefficient. 

AC3  -  (REAL*8)  Same  as  ACl,  except  it  is  the  second  order  coefficient. 


CARD12 

BDl  -  (REAL*8)  The  constant  used  to  calculate  the  temperature-dependent  calibration  coefficient 
B  (if  EQN  =  AB’)  or  D  (if  EQN  =  ’CD’). 

BD2  -  (REAL*8)  Same  as  BDl,  except  it  is  the  first  order  coefficient. 

BD3  -  (REAL*8)  Same  as  BDl,  except  it  is  the  second  order  coefficient.  If  BD2  =  BD.l,  then  D 
will  be  a  constant  equal  to  BDl. 


CARD13 

T1  -  (REAL*8)  The  constant  used  to  calculate  the  temperature-dependent  calibration  coefficient 

To. 

T2  -  (REAL*8)  Same  as  T1  except  it  is  the  first  order  coefficient. 

T3  -  (REAL*8)  Same  as  Tl,  except  it  is  the  second  order  coefficient. 

T4  -  (REAL*8)  The  third  order  coefficient,  which  is  not  used  if  BD2  =  BD3. 


CARD14 

LAB  -  (INTEGER*4)  If  LAB  =  1,  laboratory  calibrations  will  be  used  to  convert  temperature 
counts  to  degrees  centigrade.  If  LAB  =  0,  an  idealized  formula  will  be  used.  Only  LAB=1 
should  be  used. 
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TSEC  -  (REAL*4)  Counting  period  in  seconds  for  pressure.  Typically,  this  is  1800  sec,  however,  if 
a  SD  PIES  is  in  power-save  mode  the  time  would  be  shorter.  If  pressure  has  been  electronically 
prescaled  within  the  lES,  this  sampling  interval  must  be  adjusted  accordingly. 

TREFl  -  (REAL*4)  First  reference  temperature  of  the  laboratory  calibrations. 

TREF2  -  (REAL*4)  Second  reference  temperature  of  the  laboratory  calibrations. 

CTREFl  -  (INTEGER*4)  Counts  corresponding  to  TREFl. 

CTREF2  -  (INTEGER*4)  Counts  corresponding  to  TREF2. 

EXAMPLE  CONTROL  FILES 

Two  examples  of  control  files  are  listed  in  Table  3.  In  the  first  example,  the  lES  has  a  single  echo 
detector  and  pressure  and  temperature  sensors.  The  input  BUNS  data  are  in  binary  format.  The 
r  burst  consists  of  24  measurements,  which  are  contained  in  words  2-25  of  the  data  record.  The 
pressure  and  temperature  measurements  are  in  word  positions  26  and  27,  respectively.  The  sequence 
number,  held  in  word  1,  will  increment  by  2.  There  will  be  two  sampling  periods  in  one  hour,  thus 
the  sampling  interval  will  be  3?  minutes.  Only  the  records  from  58  to  17627  (with  corresponding 
sequence  numbers  of  53  to  35191)  will  be  processed.  The  time  base  is  established  by  assigning  the 
record  with  sequence  number  35191  to  the  time  of  00:59:27  UT  on  17  January,  1985. 

For  each  sample  burst,  the  representative  r  will  be  determined  as  the  median  value  from  the 
subset  of  all  measurements  with  counts  between  7280  and  7700.  This  median  r  will  be  divided  by 
20480  Hz  to  convert  it  to  seconds.  The  temperature  counts  are  converted  to  ®C  using  laboratory 
calibrations,  where  a  temperature  of  1°C  corresponded  to  counts  of  4554;  and  a  temperature  of  10°C 
,  to  46260  counts.  The  pressure  counts  did  not  overrange,  and  the  period  of  the  oscillator  will  be 
determined  by  dividing  the  counts  into  450.0  s  (30  minute  sampling  interval  divided  by  a  prescaler 
of  4),  Equation  2  will  be  used  to  determine  the  pressure  (in  psi,  and  this  is  scaled  to  decibars). 
CARDSll,  12,  and  13  contain  the  coefficients  A,  B,  and  To- 

In  the  second  example,  he  lES  has  two  echo  detectors  (types  TTA  and  TTB)  and  no  other 
sensors.  The  format  of  the  BUNS  data  is  1319.  Each  sample  burst  consists  of  32  pings;  since  both 
detectors  receive  the  return  echoes,  there  are  64  r  measurements  for  each  sampling  period.  These 
measurements  are  stored  in  words  2-65  of  the  data  record.  For  the  first  echo  detector,  the  r’s  within 
the  limits  99650  and  100325  will  be  used  to  determine  a  single  r  by  the  mode  method.  The  r's 
from  the  second  detector  that  pass  through  the  1545-1840  window  will  be  used  calculate  the  r  by 
the  median  method.  In  both  cases,  the  calculated  r  is  scaled  by  20480.0  Hz.  The  time  base  is 
established  by  assigning  the  sampling  period  with  sequence  number  707  to  11:45.00  UT  on  16  July 
1982.  There  are  four  sampling  periods  per  hour,  thus  the  sampling  interval  is  15  minutes  and  the 
sequence  number  will  increment  by  1.  Since  there  are  no  additional  sensors,  CARDS10-CARD14 
are  not  required. 


Table  3:  Two  examples  of  control  files  for  MEMOD JUL89.FOR.  See  text  for  explanation. 

Control  File  1 


iCARDl 

HEADR=’Exsimple  1:  lES  sith  pressure  and  temperature' 

$END 

$CARD2  ITT=1,  TTYPE='TTB’.  '  ’  $EID 

$CARD3  IW0RDS=27.  LBURST=24.  LBFST=2.  RDFMT=0  *EID 
$CARD4  1ISEI=2,  SEISOR=’PR*.  'TP'.'  SWDI0=26.  27,0  $EID 

$CARD5  SF1=20480.0.  SF2=0.0,  AMSF=0.0  $EID 

$CARD6  IFIRST=68.  IFSEQ=53.  »LAST= 17627,  ILSEQ=36191,  SEQIIC=2  $EID 
$CARD7  LBID1=7280,  UBMD1=7700,  LBMD2=0,  UBID=20,  DGRPHR=2 . OOD+00  $EID 
$CARD8  I0PT='  TTl',  'MEDl’,2*’  ’  lEID 

$CARD9  IYR=8S,  MITH=01,  IDAY=17,  IH0UR=00,  IMII=69,  ISEC=27,  ISEQ0=35191  $EID 
SCAROlO  Eqi='AB',  aVERIG=’IO'  lEHD 

SCARDll  ACl=6.18004E+04,  AC2=-9 . 70308E-01 ,  AC3=l .71739E-03 

$CARD12  BD1=3.17S06E-0S,  BD2=-7 . 80773E-01 ,  BD3=1 . 04970E-02 

$CARD13  Tl=2.597996E-06,  T2=-l .99643E-11,  T3*l .70393E-13,T4=0  $EID 

$CARD14  LAB=1,  TSEC=4S0.0,  TREF1=1.0,  TREF2=10.0,  CREF1=4554,  CREF2=46260  $EID 

Control  File  2 

SCAROl 

HEADR= ’ Example  2;  lES  sith  tso  travel  time  echo  detectors' 

SEND 

$CARD2  ITT=2,  TTYPE='  TTA',  '  TTB'  SEND 

SCARD3  IW0RDS=66,  LBURST=32,  LBSFT=2,  RDFMT=1  SEND 

SCAR04  ISEI=0,  SEIS0R=3*'  ',  lWaRO=3*0  SEND 

SCAR06  SF1=20480.0,  SF2=20480.0,  ANSF=0.0  SEND 

SCARD6  IFIRST=78,  IFSEQsYS,  iLAST=710,  ILSEQ=707,  SEQIIC=1  SEND 

SCARD7  LBNDl=99e50,  UBID1  =  100326,  LBID2=1546,  UBID2=1840,  DGRPHR=4 . OOD-t-OO  SEND 

$CARD8  I0PT='  TTl',  'MODI',  '  TT2',  'MEDl'  SEND 

SCARD9  IYR=82,  IMNTH=07,  IDAY=16,  IH0UR=11,  IMII=45,  ISEC=00,  ISEQ0=707  SEND 
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2.5  FILL-JAN91.FOR 

FILL  checks  the  dataset  for  proper  incrementing  of  the  time  base  and  corrects  the  errors  encountered. 
Two  types  of  time  base  errors  can  occur:  1)  a  complete  record  from  a  sampling  period  can  be  missing 
or  2)  the  time  associated  with  a  sampling  period  can  be  incorrect. 

FILL  steps  through  the  MEMOD  output,  checking  that  the  time  increment  between  successive 
samples  equals  the  expected  value  of  DELTAT,  specified  by  the  user  in  the  control  file.  If  errors  are 
found,  the  ‘out-of-sequence’  records  are  saved  in  arrays.  When  proper  incrementing  resumes,  FILL 
checks  the  records  stored  in  the  arrays  for  the  two  types  of  errors  listed  above.  If  a  record  has  an 
incorrect  time  associated  with  the  measurements,  only  the  time  is  corrected  and  the  data  values  are 
not  adjusted.  However  if  a  complete  sampling  period  is  missing  the  gap  is  filled  with  data  values 
which  have  been  interpolated  between  neighboring  good  records,  and  the  correct  time  is  associated 
with  these  values.  All  records  which  require  a  correction  are  counted  (or  ‘flagged’). 

When  the  two  types  of  errors  are  intermingled,  that  is  samples  are  missing  within  a  period  which 
has  incorrect  times,  then  missing  samples  are  inserted  before  the  group  of  samples  with  incorrect 
times.  If  isolated  good  records  are  interspersed  in  such  a  section,  missing  records  will  be  added  so 
as  to  preserve  the  good  records’  true  positions. 

The  output  consists  of  both  a  log  file  and  a  corrected  data  file.  If  the  instrument  is  a  PIES,  two 
additional  data  files  are  created:  one  for  pressure  and  one  for  temperature.  The  individual  data  files 
will  contain  the  proper  time  base  associated  with  that  particular  sensor  type  and  PIES  model  (URI 
or  Sea  Data).  The  log  file  lists  the  records  which  were  out-of-sequence  and  how  many  additional 
records  were  needed  to  fill  any  gaps.  The  total  number  of  fl.-.gged  records  are  also  reported.  The 
output  data  files  contain  two  variables  in  2E15.7  format  with  time  in  the  second  column. 

The  FORTRAN  source  code  is  listed  in  Section  3.3.  The  user  supplied  control  parameters  are 
given  below. 

CONTROL  FILE 

The  control  file  is  composed  of  three  NML  groups,  CARD1'CARD3.  These  are  in  free  format. 

CARDl 

HEADR  -  (CHARACTER*60)  A  string  containing  comment  information.  Usually  used  to  identify 
the  instrument  site  and  serial  number. 


CARD2 

NSTART  -  (1NTEGER*4)  Sequential  number  of  first  record  to  start  checking  the  times.  All  records 
prior  to  this  one  are  assumed  to  be  in  correct  order  and  are  written  to  the  output  data  set 
without  being  checked. 

NSTOP  -  (INTEGER*4)  Sequential  number  of  last  record  to  check  for  incorrect  timing.  All 
subsequent  records  are  written  to  the  output  data  set  without  being  checked. 


MAXDLT  -  (INTEGER*4)  Maximum  allowable  time  gap  in  hours.  If  this  limit  is  exceeded, 
execution  of  the  program  terminates. 

DELTAT  -  (INTEGER*4)  Sampling  interval  in  hours. 


CARD3 

PRESS  -(CHARACTER*3)  The  answer  to  whether  the  instrument  is  a  PIES  or  not.  Only  the 
first  character  is  checked;  ‘Y’  or  ‘y’  indicates  a  PIES,  and  a  pressure  file  and  a  temperature 
file  are  additionally  created. 

MODEL  -(CHARACTER*3)  Is  the  PIES  a  URI  or  Sea  Data  (SD)  model?  Only  the  first  character 
is  checked;  S’  or  ‘s’  indicates  a  SD  instrument.  This  information  is  used  to  determine  which 
set  of  offsets  to  apply  to  r  time  base  to  get  the  appropriate  time  bases  for  pressure  and  for 
temperature. 


trMVrl  Ijiru,* 
I  iclt* 
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2.6  DETIDE-AUG90.FOR 

DETIDE  reduces  the  effect  of  the  tide  in  the  travel  time  record  (Fig.  5).  The  tidal  signature  in 
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Figure  5:  The  measured  travel  time,  the  prediction  of  the  tide’s  effect  on  travel  time,  and  the 
‘detided’  travel  time. 

travel  time  is  composed  of  two  opposing  effects.  For  a  tidal  elevation  rj,  the  acoustic  path  increases 
by  2q,  but  the  speed  of  sound  increases  due  to  the  increase  in  hydrostatic  pressure  {pgr}).  The  two 
effects  may  be  expressed  as 

Arpa,h(r;)  =  ^ 


Arp„.,(T?)  -  <.,+Ac,(.j)  c.  -  (..  AcU)^  ~ 


0- 


Ac,(t)) 

c. 


here  c,  is  the  speed  of  sound  for  the  region  of  mean  depth  H\  6c,  is  the  variation  in  sound  speed 
resulting  from  the  tidal  height,  t}.  These  expressions  may  be  combined  and  simplified  by  using 
binomial  expansion  and  by  utilizing  the  approximately  linear  relation  between  sound  speed  and 
pressure.  The  net  change  in  travel  time  can  be  expressed  as 


Ar  =  — , 

C.7 


7  =  1  +  (f 


The  user  supplies  c,  and  7  (CBAR  and  PFACTR)  in  the  control  file.  CBAR  is  determined 
for  the  region  and  depth  from  the  Matthews  table  (found  in  Handbook  of  Oceanographic  Tables, 
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Section  III,  Table  11.  Bialek,  1966).  The  PFACTR  may  be  calculated  from  the  instrument  depth 
=s  1.1  X  10”^s~')-  The  scaled  tidal  heights  are  subtracted  from  the  measured  r's  to  create  a 
set  of  ‘detided’  r’s. 

The  tide  (rj)  is  estimated  using  the  amplitude  and  phases,  H  and  g.  of  eight  of  the  most  significant 
tidal  constituents  (  Mo,  No,  So,  Ko,  Ki,  Oi,  Pi,  and  Qi)  which  are  supplied  in  the  control  file-. 
The  tidal  signal  is  predicted  by 

8 

nit)  =  Hnfn  COS{u)„t  -  gn+  Vn  +  U„  ) 

n  =  1 

where  a;„  is  the  angular  frequency  of  the  n’th  constituent,  Vn  is  the  phase  of  the  equilibrium  tide 
at  time  zero,  /„  is  the  nodal  factor,  u„  is  the  nodal  correction.  The  time,  <,  associated  with  each 
sampling  period  is  referenced  to  Universal  Time. 

The  control  file  contains  the  time-dependent  node  factor  (/)  and  equilibrium  argument  (I'o  -I-  u) 
for  each  constituents.  The  /„  and  Un  factors  account  for  small  but  significant  variations  resulting 
from  the  modulation  of  both  Hn  and  gn  with  the  regression  of  the  moon’s  ascending  node.  The 
factors  /  and  u  are  considered  constant  for  any  one  year,  but  varies  from  year  to  year  with  the 
regression’s  period  of  18.6  years.  (For  solar  constituents,  /  =  1  and  u  =  0.)  The  yearly  values  are 
tabulated  in  the  literature  pertaining  to  tidal  prediction  by  Harmonic  Analysis  (e.g..  Tables  14  and  15 
in  Schureman,  1941).  Tables  4  and  5  list  the  nodal  factors  and  the  equilibrium  arguments,  of  the 
eight  constituents  for  years  1973  to  1999. 

Since  the  tides  are  generated  sequentially,  the  input  data  set  must  not  be  missing  any  records; 
thus  the  data  set  produced  by  FILL  is  used  as  the  input. 

The  output  consists  of  a  log  file  and  a  disk  data  file.  The  log  file  lists  the  tidal  components  used 
to  generate  the  tidal  amplitudes.  The  disk  data  set  consists  of  seven  variables  written  in  (4E15.7) 
format.  In  order,  these  are:  measured  r  (in  seconds),  detided  r  (in  seconds),  predicted  tide  (in 
seconds),  and  time  (in  yearhours). 

The  FORTRAN  source  code  is  listed  in  Section  3.5.  The  user  stipplied  control  are  listed  below. 

CONTROL  FILE 

The  control  file  consists  of  seven  name  list  groupings,  CARDl  -  CARD7,  which  are  in  free  format. 

CARDl 

HEADR  -  (CHARACTER*60)  Alphantimeric  array  containing  comment  information. 


^The  umplitudes  «uid  phases  were  derived  using  the  results  of  Response  Analysis  applied  to  the  bottom  pressure 
records.  Response  analysis  is  described  in  Section  2.9.  The  bottom-pressure  tidal  signal  is  related  to  the  sea  surface 
elevation  by  the  hydrostatic  equation. 
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Table  4;  Node  Factor,  /,  for  middle  of  each  calendar  year,  1973  to  1999  (Schureman,  1941) 
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Table  5:  Equilibrium  Argument  (V'o  +  “)  for  the  Greenwich  Meridian  at  the  beginning  of  each 
calendar  year,  1973  to  1999  (Schureman,  1941) 


Year 

M2 

Nj 

S2 

Contituent 

K2  K, 

0, 

Pi 

Qi 

1973 

84.5 

270.0 

0.0 

218.4 

19.0 

61.7 

349.5 

247.2 

1974 

185.3 

282.0 

0.0 

218.2 

19.2 

162.0 

349.7 

258.7 

1975 

285.8 

293.8 

0.0 

215.8 

18.2 

263.5 

350.0 

271.5 

1976 

26.0 

305.3 

0.0 

211.5 

16.2 

6.5 

350.2 

285.8 

1977 

101.8 

279.3 

0.0 

207.6 

14.1 

85.7 

349.5 

263.2 

1978 

201.8 

290.6 

0.0 

200.9 

10.5 

191.3 

349.7 

280.1 

1979 

301.9 

301.9 

0.0 

194.2 

6.8 

296.9 

349.9 

297.0 

1980 

42.0 

313.3 

0.0 

188.2 

3.7 

41.6 

350.2 

312.9 

1981 

117.9 

287.4 

0.0 

185.6 

2.5 

119.4 

349.4 

289.0 

198‘2 

218.4 

299.2 

0.0 

133.1 

1.5 

221.1 

349.4 

301.9 

1983 

319.1 

311.2 

0.0 

182.6 

1.5 

321.4 

349.9 

313.5 

1984 

60. 

323.4 

0.0 

184.2 

2.4 

60.8 

350.2 

324.2 

1985 

136.8 

298.4 

0.0 

189.3 

4.9 

134.2 

349.4 

295.8 

1986 

238.1 

311.0 

0.0 

193.5 

6.9 

232.6 

349.6 

305.4 

1987 

339.6 

323.7 

0.0 

198.3 

9.2 

330.7 

349.9 

314.8 

1988 

81. 

336.4 

0.0 

203.3 

11.6 

68.8 

350.1 

324.2 

1989 

158.1 

311.7 

0.0 

210.0 

14.8 

141.6 

349.4 

295.3 

1990 

259.4 

324.3 

0.0 

213.9 

16.7 

240.1 

349.6 

305.0 

1991 

0.5 

336.7 

0.0 

216.6 

18.0 

339.0 

349.8 

315.2 

1992 

101.3 

348.8 

0.0 

217.6 

18.7 

78.7 

350.1 

326.1 

1993 

177.6 

323.3 

0.0 

218.5 

19.4 

154.0 

349.3 

299.7 

1994 

278.0 

334.9 

0.0 

210.4 

18.0 

256.1 

349.6 

313.0 

1995 

18.2 

346.4 

0.0 

210.3 

15.6 

359.7 

349.8 

327.9 

1996 

118.3 

357.8 

0.0 

204.0 

12.2 

104.8 

350.1 

344.3 

1997 

194.0 

331.7 

0.0 

199.2 

9.5 

185.2 

349.3 

322.9 

1998 

294.0 

83.0 

0.0 

192.7 

6.0 

290.5 

349.6 

339.5 

1999 

34.2 

354.5 

0.0 

187.2 

3.2 

34.6 

349.8 

354.9 
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CARD2 

NFIRST  -  (INTEGER*4)  The  number  of  the  first  record  to  process. 

NLAST  -  (INTEGER*4)  The  number  of  the  last  record  to  process. 

lYR  -  (INTEGER*4)  Year  for  which  the  tidal  parameters  are  to  be  calculated. 

DELT  -  (REAL*4)  Sampling  interval  in  hours. 


CARD3 

H(8)  -  (REAL*4)  Array  of  half  amplitudes  in  centimeters  for  tidal  constituents  in  the  following 
order:  Mq,  Nt,  St,  Kt,  Ki,  Oi,  Pi,  and  Qi. 

CARD4 

PHI(8)  -  (REAL*4)  Array  of  phases  in  degrees  (Greenwich  epoch)  corresponding  to  the  amplitudes 
given  in  H. 


CARDS 

F(8)  -  (REAL*4)  Array  of  f  node  parameters  for  the  middle  of  the  calendar  year.  Given  in  the 
same  order  as  above. 


CARD6 

VU(8)  -  (REAL*4)  The  equilibrium  argument  (Vo  +  u)  for  the  Greenwich  meridian  at  the  begin¬ 
ning  of  the  calendar  year.  Given  in  the  same  order  as  above. 


CARD7 

CBAR  -  (REAL*4)  The  average  sound  velocity  for  the  location  and  depth  of  the  lES. 

PFACTR  -  (REAL*4)  Factor  used  to  modify  the  speed  of  sound  (CBAR)  to  account  for  the 
variation  in  sound  speed  resulting  from  the  tidal  variation  in  pressure  (pgT){t)). 

LOCN  -  (CHARACTER*  10)  The  string  used  to  identify  the  location  and  depth  to  which  CBAR 
and  PFACTR  apply. 
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2.7  DESPIKE_AUG90.FOR  and  DESPIKE.TP.FOR 

DESPIKE  identifies  spikes  in  the  measurements  and  replaces  them  with  interpolated  values.  A 
spike  is  defined  either  as  a  measurement  which  exceeds  specified  limits  or  as  one  which  increases 
(or  decreases),  from  the  preceeding  few  measurements,  more  rapidly  than  a  specified  rate.  Figure  1 
illustrates  a  travel  time  record,  both  before  and  after  being  processed  by  despike. 

There  are  two  DESPIKE  programs:  DESPIKE-TP.FOR  which  is  applied  to  temperature  or 
pressure  files  (from  the  FILL  step),  and  DESPIKE-AUG90.FOR  which  runs  on  the  travel  time 
(from  DETIDE).  The  difference  in  the  programs  only  amounts  to  operating  on  different  columns  of 
the  file. 

Within  the  control  file,  the  user  specifies  the  upper  and  lower  bounds  within  which  the  measure¬ 
ments  are  considered  reliable  (VMAX  and  VMIN).  Values  outside  of  the  specified  range  are  replaced. 
The  maximum  gradient  (SLOPEl)  to  be  tolerated  is  specified  in  CARD3. 

Upon  execution.  DESPIKE  first  checks  whether  a  measurement  falls  within  the  specined  range. 
If  the  measurement  meets  this  criterion,  the  value  is  then  tested  to  make  sure  that  it  has  not  changed 
by  an  amount  that  is  larger  than  expected  relative  to  the  average  of  the  previous  LAVGl  points 
(‘slope  method’).  A  measurement  which  fails  either  of  these  two  tests  is  stored  in  a  temporary  array. 
The  subsequent  measurements  are  tested  and,  if  they  also  fail  either  test,  are  stored  in  the  array. 
When  the  next  ‘good’  (one  which  meets  both  criteria)  value  is  found,  all  spikes  stored  in  the  array 
are  replaced  with  values  which  have  been  interpolated  betweeii  the  neighboring  good  values.  For 
travel  time,  this  procedure  is  applied  to  the  detided  r.  The  measured  r  is  adjusted  accordingly  by 
adding  the  appropriate  tidal  height  (in  seconds). 

The  initial  running-average,  to  initiate  the  ‘slope  method’  of  despiking  (RNAV'Gl)  is  specified 
within  CARD3  of  the  control  file,  A  RNAVGl  value  of  zero  directs  DESPIKE  to  simply  use  the 
average  of  the  first  LAVGl  points  (Best  used  only  when  confident  that  the  first  LAVGl  points  are 
free  of  spikes).  Once  started,  the  running  average  is  updated  each  time  a  good  data  point  is  written 
to  the  output  file. 

The  ‘slope  method’  may  be  visualized  as  a  beam  emanating  forward  from  a  point  at  the  center 
of  an  averaging  interval.  The  width  of  the  beam  is  controlled  by  SLOPEl.  The  width  is  also 
affected  by  the  number  of  points  in  the  running  average,  LAVGl.  Consider  a  sample  at  a  specific 
time  being  tested  (good  or  spike).  The  distance  between  the  test  point  and  the  origin  of  the  beam 
increases  with  the  length  of  the  averaging  interval;  thus,  for  a  given  SLOPEl  increasing  the  LAVGl 
widens  the  beam  at  the  test  point.  However,  LAVGl  also  tunes  the  smoothness  of  the  beam’s  path. 
As  the  beam  is  stepped  forward  in  time,  the  path  the  beam  follows  is  smoothed  by  this  effective 
running-average  filter. 

The  program  ‘flags’  certain  replacements  for  which  it  has  sou.c  d'^uHt.  When  a  point  fails  the 
slope  test  but  is  less  than  the  next  consecutive  ‘good’  point  it  is  replaced  by  an  interpolated  value. 
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but  a  flag  is  issued  in  the  output  list  file. 

Three  output  files  are  generated:  1)  a  list  file  which  gives  details  of  the  replacements,  2)  a  log 
file  that  documents  the  control  file  used  with  a  summary  of  the  list  file,  and  3)  the  output  data  file, 
which  has  the  same  format  as  the  DETIDE  output  data  file,  or  the  same  format  as  the  FILL  data 
file  if  the  variable  is  pressure  or  temperature. 

The  FORTRAN  source  code  is  listed  in  Section  3.6  and  the  contents  of  the  control  file  are  listed 
below. 

CONTROL  FILE 

Three  NML  groups  make  up  this  file,  CARDl  -  CARDS.  They  are  all  read  in  free  format. 

CARDl 

HEADR  -  (CHARACTER*60)  string  containing  comment  information. 

CARD2 

TINTVL  -  (REAL*4)  Time  interval  in  hours  between  data  points. 

VMAX  -  (REAL*4)  Upper  bound  delimiting  acceptable  measurements. 

VMIN  -  (REAL*4)  Lower  bound  delimiting  acceptable  measurements. 

CARDS 

SLOPE!  -  (REAL*4)  The  allowed  rate  of  change  per  hour  (in  the  same  units  as  the  data  -  seconds, 
dbars,  or  degrees  Celsius). 

RNAVGl  -  (REAL*4)  Initial  value  for  the  running  average  of  LAV'Gl  samples.  If  RNAVGl  =  0.0, 
the  program  computes  its  value  by  averaging  the  first  LAVGl  points. 


LAVGl  -  (REAL*4)  Number  of  points  used  to  compute  the  running  average. 


2.8  SEACOR-AUG90.FOR 


SEACOR  removes  the  effect  of  seasonal  warming  ai*d  cooling  of  the  surface  layers  from  the  travel¬ 
time  measurements.  A  long-term-average  seasonal  cycle  is  used  to  estimate  this  correction,  f'or 
instance,  in  the  Ciulf  Stream,  the  travel  time  varies  seasonally  1-1.8  msec  independent  of  lateral 
shifts  in  the  Gulf  Stream’s  position;  this  seasonal  change  would  correspond  to  a  20-36  m  bias  error 
in  the  main  thermocline  depth,  if  not  removed.  The  user  supplies  a  .seasonal  correction  curve  for  the 


Figure  6;  The  three  regions  represent  the  dominant  spatial  variation  of  the  seasonal  corrections  to 
travel-time. 

specific  oceanic  region  where  the  lES  was  deployed.  This  curve  consists  of  24  values,  one  for  each 
month  for  a  two-year  period.  The  yearhours  corresponding  to  these  correction  factors  (assumed  to 
be  the  first  day  of  each  month)  are  also  specified.  Currently,  SEACOR  has  three  sets  of  correction 
factors;  these  are  initialized  in  DATA  statements.  The  correction  factors  represent  three  different 
regions  in  the  Gulf  Stream.  The  particular  set  to  be  used  is  specified  in  the  third  NML  group  of  the 
control  file.  For  locations  other  than  those  shown  in  Figure  6  the  SEACOR  code  must  be  modified 
to  recognize  a  new  region  specification.  Figure  7  shows  the  seasonal  cycle  for  the  three  Gulf  Stream 
regions. 

The  correction  factors  were  determined  with  data  from  historical  archives.  Over  5000  XBT 
and  CTD  casts  in  the  Gulf  Stream  region  were  examined  for  seasonal  and  regional  variations.  It 
was  found  that  down-stream  variation  dominated  the  spatial  dependence,  and  the  three  regions  in 
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Figure  6  were  chosen  to  represent  the  effect .  The  cross-st  rermi  ilepemience  of  ilie  seasonal  rorri  ci  s  m 
was  considered  insignificant  in  this  region. 


SEArOR  Correction  Fatrlors 

rf^ion  1 _ 

rrgion  2  _ _ _ _ 

rr^ujti  3  _ _ _ _  _ 


yearhour 


Figure  7:  The  seasonal  correction  factors  for  the  tliree  regions  displayed  in  Figure  6. 

The  data  set  produced  by  DESPIKE  is  used  as  input.  The  correction  factor  t(j  be  used  for  each 
sampling  period  is  determined  by  linearly  interpolating  between  the  monthly  values  stored  in  the 
array.  Then  this  correction  factor  is  added  to  both  the  measured  and  detided  r’s  of  each  sampling 
period. 

Within  the  control  file,  the  user  specifies  if  the  deployment  period  spans  one  or  two  calendar  years 
and  if  any  year  involved  is  a  leap  year.  The  appropriate  yearhotirs.  as.soriated  with  the  monthly- 
correction  factors,  are  adjusted  when  either  of  these  years  is  a  leap  year. 

The  output  consists  of  two  files:  A  log  file,  which  lists  the  monthly  correction  factors  and  their 
associated  yearhours;  and  the  data  file,  which  contains  the  seasonally  corrected  r's  in  the  same 
format  as  the  DESPIKE  output  data  file. 

The  FORTRAN  .source  code  is  listed  in  Section  3.7. 


CONTROL  FILE 


This  file  is  composed  of  three  NML  groups,  CARDl  -  CARD3. 

CARDl 

HEADR  -  (CHAR ACTER*80)  Alphanumeric  variable  containing  comment  information 

CARD2 

NPTS  -  (INTEGER*4)  .Number  of  sampling  periods  to  process. 

NOYRS  -  (INTEGER*4)  Number  of  calendar  years  spanned  by  the  dataset. 

FRSTYR  -  (CH.\R.\CTER*‘2)  .Alphanumeric  code  designating  whether  or  not  the  first 
leap  year.  Options  are  ''I'E'  or  ‘NO’. 

SCNDYR  -  (CHARACTER’'‘2)  .Same  as  FRSTYR,  except  for  the  second  year 

CARD3 

REGION  -  (II)  A  number  specifying  the  geographic  region  of  the  record. 


do 


year  is  a 


;i() 

2.9  RESPO_JUL88.FOR 

RESPO  removes  the  tide  from  the  bottom  pressure  using  Response  Analysis  to  predict  the  tidal 
signal.  F'igure  8  illustrates  detiding  by  RESPO  in  the  time  domain,  while  Figure  9  represents  the 
frequency  domain  expression. 
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Figure  8:  The  uppermost  panel  displays  the  measured  bottom  pressure;  the  middle  panel  represents 
the  portion  of  the  measured  bottom  pressure  resulting  from  the  tide;  and  the  bottom  panel  is  the 
residual  bottom  pressure. 

Response  analysis  constructs  and  applies  a  predictive  filter  which  represents  the  ocean’s  response 
to  gravitational  forcing.  Sometimes  moderately  nonlinear  interactions  and  non-gravitational  forcing 
(e.g.,  the  radiational  tide)  are  included.  Unlike  the  related  harmonic  analysis,  the  response  analysis 
assumes  nothing  about  which  frequencies  are  present,  because  the  input  function  is  derived  directly 
from  the  Newtonian-Keplerian  orbital  motions;  the  input  function  contains  all  the  variations  of 
the  astronomic  forcing  regardless  of  size.  The  oceanic  response  is  considered  distinctly  from  the 
astronomic  forcing.  The  method  also  has  a  more  physical  basis  than  harmonic  analysis  since  it 
treats  the  ocean  as  a  dynamical  system. 

A  simple  filter  may  be  expressed  as, 

k 

where  y  is  the  predicted  tide,  x  is  the  input  function,  and  t  is  the  response  of  the  ocean  to  a  unit 


a: 


Detiding  Pressure  Using  RESPO 


Figure  9:  The  power  spectral  density  of  the  (A)  measured  bottom  pressure,  (B)  the  residual  bottom 
pressure,  and  (C)  the  40  hr  low-pass  filtered  residual. 

impulse  of  x  at  time  zero. 

The  tidal  prediction  illustrated  by  Equation  3  depends  only  on  the  input’s  temporal  variation 
at  that  particular  location.  As  a  refinement  the  forcing  at  other  locations  may  be  included  in  the 
prediction: 

y{t)  =  YU2  -  ’■*)- 

f  k 

where  ‘i’  represents  forcing  at  neighboring  locations  that  might  influence  sea  level  at  the  site  of 
interest.  Response  analysis  systematically  includes  spatial  dependence  by  expanding  x  in  surface 
spherical  harmonics.  The  predicted  tide  is  expressed  as  a  filter  acting  on  the  complex- valued,  time- 
varying  amplitudes  of  the  spherical  harmonic  functions  representing  the  equilibrium-tidal  potential. 

y(t)  =  E  L  “'n  -  n)  (5) 

ik  ns2m=0 

The  indices  n  and  m  are  the  degree  and  order  of  the  surface  spherical  harmonic  functions.  C”(t), 
which  replaces  x,  is  the  set  of  time- varying  amplitudes  of  the  corresponding  spherical  harmonic 
functions.  The  «;{),,  which  replace  /,  are  the  complex  weights  associated  with  each  Using 

the  data  to  be  detided,  (»?(<;)),  the  weights  are  found  by  solving  the  overdetermined  set  of 

equations  such  that  the  difference  between  the  data  and  the  predicted  tide  (»?(f;  )~y(fi))  minimized 
in  a  least-squares  sense. 
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The  equilbrium-tidal  potential  for  a  mass  M ,  whose  center  of  mass  is  at  distance  p  from  the 
point  of  observation  is: 

V(t)  _ 

9  9P 

where  V'(t)  is  the  gravitational  potential  due  to  mass  M,  G  is  the  gravitational  constant,  and  g 
is  local  gravity.  Typically,  ninety-nine  percent  of  the  gravitational  tidal  variance  can  be  explained 
with  the  equilibrium-tidal  potential  (due  to  the  masses  of  the  moon  and  sun)  represented  by  just 
the  Cjand  {n=2,  m=l,  2}  amplitude  functions. 

The  spherical  harmonics  corresponding  to  Ci  and  Cl  are  illustrated  as  viewed  down  the  axis 
of  rotation  in  Figure  10.  The  plus  sign  represents  bulging  relative  to  the  geoid,  the  minus  sign, 
flattening.  From  this  illustration,  it  is  apparent  that  Cj  and  Cj  are  associated  with  the  diurnal  and 
semi-diurnal  species  of  the  harmonic  analysis.  RESPO  is  set  up  to  use  these  functions  (Cj  and  Cl) 


Cl  C| 

Figure  10:  The  spherical  harmonics  associated  with  and  C|  are  viewed  from  the  axis  of  rotation. 
Plus  and  minus  signs  correspond  to  bulging  and  flattening  relative  to  the  geoid. 

as  input  at  time-lags  of  rn  =  it  ♦  48  hr,  it  =  —1,0, 1.  Thus  Equation  5  is  then  truncated  to; 

1  2 

y(t)  =  Re  *  48)C^(t  -  k  *  48)  (6) 

t  =  —  1  m  =  l 

The  6  weights,  w^(k  *  48hr),m  =  1,2  k  =  —1,0, 1  are  found  from  the  overdetermined  set  of 
equations. 

=  Re(C(tj)*W),  (7) 

where  C(tj)  =  [C^(tj -1- 48)  C^ftj)  C^(<j  -  48)  C|«j -(- 48)  Cj-ftj )  C|(t;  -  48)], 

/  ^(48)  \ 

lelfO) 

U'2(— 48) 

11/2(48) 
u/^(0) 

\  u/^(-48) 


and 


W 
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These  weights  are  applied  to  the  Cp  to  generate  the  predicted  fide.  This  is  subtracted  from  the 
original  data  T)(tj)  to  give  the  residual  tide. 

Use 

RESPO  operates  on  the  DESPIKE  output  file  and  a  control  file.  It  creates  an  output  data  file 
and  a  log  file.  The  four  columns  of  the  output  data  file  contain  the  raw  pressure,  detided  pressure, 
predicted  tide,  and  sample  time.  The  log  file  contains  relevant  information  about  the  response 
analysis  and  the  equivalent  harmonic  constituents. 

Control  File 

The  control  file  consists  of  3  namelist  groups.  They  are  assigned  the  names  CARDl,  CARD2,  and 
CARD3.  A  sample  control  file  has  the  form  shown  below. 

$CARD1 

HEADR=  'piea89g2_213  RESPO  '  Send 
SCARD2 

FORM=  '(46X,E15.7.30X,E15.7)>  Send 

SCARD3  length=22772,  year=1989,  yearhr=-5253. 253125,  d=0 . 500004845  Send 

The  namelists  are  read  free  format.  The  variables’  data  types  and  definitions  are  listed  below; 

CARDl 

HEADR  -(CHARACTER*40)  This  is  the  Header  to  be  used  in  the  output  log  file.  IIEADR 
typically  contains  the  site  and  recovery  cruise  number  in  order  to  identify  the  record.  The 
string  should  be  enclosed  in  quotes. 


CARD2 

FORM  -(CIIARCTER*40)  This  string  is  format  specification  for  reading  pressure  and  time,  in 
that  order.  In  the  case  of  a  non-standard  input  file,  in  which  time  comes  before  pressure  the 
“TL”  format  specifier  may  be  used  to  space  backwards,  after  reading  pressure,  to  read  time. 
For  a  7E15.7  file,  the  format  ‘(90X,E15.7,TL60,E15.7)’  would  read  the  7th  entry  in  the  record 
and  then  the  4th. 

CARD3 

LENGTH  -(1NTEGER*4)  The  number  of  sample  records  in  the  time  series. 

YEAR  -(INTEGER*4)  Reference  year  from  which  time  in  yearhour  is  expressed.  For  example,  if 
l-Jan-1990  is  defined  as  yearhour  OOOOZ  then  YEAR=1990. 

YEARHR  -(REAL*8)  Yearhour  of  first  pressure  sample.  This  time  corresponds  to  the  center  of 
the  half-hour  measurement  period. 

D  -(REAL*4)  The  interval  between  successive  samples.  Nominally  D  is  0.5  hr;  slight  drifts  over 
long  deployments  may  lead  to  an  effective  sampling  interval  differing  from  this  by  a  part  in 
one  million,  which  is  accounted  for  in  double  precision. 


response 
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2.10  FILTER-NAMES.M 

Residual  pressure,  temperature,  and  travel  time  are  filtered  and  subsampled  using  functions  from 
MATLAB  and  MATLAB’s  Signal  Processing  Toolbox.  The  functions  were  collected  into  a  routine 
called  FILTER-NAMES.M.  Additionally,  travel  time  (r)  is  scaled  to  Z12 


^2 


2nd— order  Butterworth 
Transfer  Function 


one  pass,  HH’ 


Figure  11:  The  transfer  function  for  the  2nd-order  Butterworth  filter  is  illustrated  (solid)  along  with 
the  effective  transfer  function  (dashed)  corresponding  to  the  forward  and  backward  application  of 
the  filter.  The  filter  cutoffs  are  0.025  hr~*  (solid)  and  0.02  hr”'  (dashed). 

FILTER J*J AMES  calls  a  2nd-order  recursive  filter  of  the  general  form  given  by: 

y(<n)  =  box{tn)  +  6ix(t„_i)  +  62x(t„_2)  -  aiy(<„_i)  -  aiy{t„-2)  (8) 

The  recursive  filter  depends  on  both  the  input  series  to  be  filtered  (x(l)i^  £  *n))  and  the  output 
(y(<),(t  <  t„)).  The  value  of  y(tn)  depends  on  x(t„)  and  past  values  of  x(t)  and  y(t);  the  filter  is  not 
symmetric.  Since  recursive  filters  are  *one-sided’  there  is  a  distortion  of  the  phase  relation  between 
the  input  and  the  output.  This  distortion  can  be  removed  by  filtering  twice:  once  passing  forward 
in  time  and  once  passing  backward. 

The  filtering  twice  affects  the  overall  transfer  function  of  the  operation.  The  order  of  the  com¬ 
bination  (forwards  and  backwards)  filtering  is  double  that  of  a  single  pass;  The  transfer  function  is 
squared  which  results  in  a  overall  cutoff  frequency  (half  power  point)  that  is  reduced  relative  to  the 
cutoff  for  the  original  filter  (single  pass). 
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The  Butterworth  filter  design  is  known  for  its  characteristic  sharp  monotonic  transition  between 
flat  pass  and  stop  bands  with  a  minimum  of  coefficients.  The  Butterworth  is  also  well  known  and 
ii.sed  regularly  in  the  oceanographic  field.  FILTER-NAMES  is  a  2nd-order  Butterworth  with  a  cutoff 
frequency  of  40  hr.  The  equation,  for  half  hour  sample  spacing,  is  simply, 

y{t„)  =  0.0015x(t„)  +  0.0029x(<„_i)  +  0.0015x(t„_2)  -  1.8890i/(t„_i)  -  0.8950i/(t„_o).  (9) 

As  described  above,  the  filter  is  passed  over  the  data  forward  and  reverse,  so  the  effective  order  and 
cutoff  frequency  are  4  and  0.02004  hr”'  (49.89  hr). 

Transients  at  the  records’  ends  are  reduced  by  removing  a  linear  ramp  generated  from  the  first 
and  last  points  of  the  series  before  filtering.  The  same  linear  ramp  is  added  after  filtering.  Twenty 
hours  of  data  at  each  end  of  the  filtered  series  are  discarded  to  avoid  contamination  by  startup 
transients. 

The  filter’s  cutoff  frequency  of  0.02004  hr”'  (49.89  hr)  suitably  removes  the  tides  and  inertial 
motions  while  preserving  the  content  associated  with  the  Gulf  Stream’s  motion  (Figure  11).  Over 
96%  of  the  variance  due  to  the  Gulf  Stream  is  at  periods  greater  than  four  days,  or  equivalently  f  < 
0.0104  hr”'  (Watts  and  Johns,  1982). 

After  filtering,  the  routine  subsamples  the  time  series  at  six-hour  intervals  centered  on  0000, 
0600,  1200,  and  1800  UT.  A  subroutine  SUBSAMPLE. M  moves  through  the  data  in  jumps  of  six 
hours,  however  it  checks  the  time  of  the  sample  as  it  procedes  and  occassionally  (usually  only  once, 
if  at  all),  it  must  adjust  by  one  sample  (0.5  hr).  This  adjustment  is  necessary  when  the  clock  drifts 
such  that  the  sample  time  of  the  lES  shifts  from  one  side  of  an  hour  to  another  (e.g.  02;01  to  01:59). 

CONTROL  FILE 

The  control  file  for  FILTER-NAMES. M  is  another  M-file,  NAMES. M.  Within  NAMES. M  arrays 
are  assigned  which  contain  the  filter  coefficients;  the  names  of  the  files  to  be  filtered;  and,  if  r  is 
being  filtered,  the  calibration  parameters  (B-intercepts).  When  FILTER-NAMES  calls  NAMES  the 
following  variables  are  filled: 

Arrays  b  and  a 

b  -  An  array  of  coefficients  which  multiply  the  input  time  series,  as  in  Equation  8.  The  coefficients 
in  the  equation,  bo,b\,  and  62  are  b(l)-b(3). 

a  -  An  array  of  coefficients  which  multiply  the  past  output,  t/(<),  as  in  Equation  8.  The  coefficients 
in  the  equation,  ao,ai,  and  02  are  a(l)-a(3).  Note  ao  =  a(l)  =  1. 

Array  z 

z  -  An  array  of  strings  containing  the  names  of  the  files  to  be  filtered.  All  names  must  be  the  same 
length  (Note,  in  the  example  below,  some  are  padded  with  blanks  on  the  left).  The  string 
is  concatenated  with  whatever  suffix  or  prefix  already  incorporated  into  the  ‘load’  statment 
within  FILTER-NAMES.  For  example,  a  suffix  may  need  to  be  adjusted  depending  on  the 
input  file  (e.g.  ‘.seacor’,‘.despike-prs’,  ‘  despike-tmp’). 
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Array  bints 

bints  -  The  b-intercepts  for  calibrating  r  to  Zi2- 


MATLAB  is  case  sensitive,  thus  NAMES. M  and  FILTER-NA.MES.M  e.xpect  input  variables  in 
lower  case  (see  the  example  NAMES. M  M-file  listed  below).  The  names  within  ‘z’  are  strings  and 
must  each  be  enclosed  in  single  quotes  as  in  the  example  below.  Square  brackets  enclose  elements 
of  an  array,  and  semicolons  terminate  rows.  Note  that  ’  is  a  comment  character  and  everything 
on  a  line  after  the  percent  is  considered  a  comment  and  is  not  executed. 

The  function  ‘butter’  is  a  Signal  Processing  Toolbox  routine  to  calculate  the  filter  coefficients. 
The  arguments  are  the  order  of  the  filter  and  the  cutoff  frequency  (scaled  by  the  nyquist  frequency). 


*/,  Central  Array  87-88 


y.  Bints  from  Z12STAR 

•/ 

calibration 

•/. 

YR 

lES 

BUT* 

S* 

2=C 

’PIES88H2’ 

y.88 

62 

5392.289 

16.646 

’PIES88H3’ 

y.88 

63 

2260.729 

14.822 

'  IES88H4' 

y.88 

64 

2428.124 

33.821 

•  IES88H5' 

y.88 

65 

1171.654 

34 . 532 

'  IES88I1' 

00 

00 

71 

1022.707 

32.972 

'PIES88I2' 

y,88 

72 

4719.848 

14.738 

’  IES88I3’ 

y.88 

73 

6353.378 

18.287 

'  IES88I4' 

y.88 

74 

3691.656 

21.180 

’  IES88IS']  y.88 

75 

5548 . 324 

2.139 

[b,a,]=butter(2, .025) ; 

bint8=[5392. ;2261 . ;2428. ; 1172. ; 1023. ;4720. ;6363. ;3692. :5548.] 
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3  PROGRAM  CODE 

3.1  BUNS_AUG89.FOR 


1 

2 

3 

4 

5 

6 

7 

8 
9 

10 

11 

12 

13 

14 


C**********************************************************************^**m** 
C***** 

PROGRAM:  BUMS. APR88 . FOR 

PURPOSE:  To  replac*  the  original  CARP  and  BUIS  programs.  Reads 
the  data  file  created  from  the  cassette  reader  emd  interprets 
the  message  codes .  The  good  data  bits  are  then  decoded  into 
32-bit  computer  Hords. 


c***** 

c***** 

cecccfl 

cccecc 

ccccec 

ce«««« 

cflMCfl 


Revised  Nay  1989  BUIS_MAY89.F0R 

Includes  the  follosing  steps  for  plotting  the  data: 

a)  writes  only  every  4th  sample  to  unformatted  plot  files 

b)  10  Isbs  of  tau  amd  seqno  are  written  to  separate  files 
in  addition  to  the  full  values 


15 

cCCCflC 

16 

17 

C*****  I/O  UNITS: 

KREAD 

= 

7  — > 

18 

KCTRL 

= 

8  — > 

19 

KLOG 

= 

9  — > 

20 

KWRITE 

= 

10  — > 

21 

KPLOTS 

= 

11  — > 

22 

KSEQ 

= 

12  — > 

23 

KPRS 

= 

13  — > 

24 

KTNP 

= 

14  — > 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 


c««««<  Revised  AUG  1989 


Input  data 

Input  control  card  file 
Output  log  file 
Output  data  (all  types) 

Output  PLOTS  data  (TT’s  only) 

Output  sequence  numbers  for  PLOTS 
Output  pressure  data  for  PLOTS 
Output  temperature  data  for  PLOTS 

»«*«*** 

BUIS_AUG89.F0R 

c*****  Modified  from  buns_may89  so  that  no  "junk"  was  inserted  at  the  end 
c*****  of  the  buns  plots. 

IITEGER*4  OUTREC(IOO).  SAMPLIIG.PERIOD,  mask.  Isb(lOO) 

IITEGER*4  KPL0T5,  KSEQ,  KPRS,  KTNP .klsb.kslsb 
IITEGER*2  HUM.  IVDS,  lUMBIT 
IITEGER*2  ISHIFT(IO),  OUTWDS 
IITEGER*4  TESTW(20),  TESTV(20) 

IITEGERM  IH.  OW.  IT,  LASTWD,  IPTAU,  IPSEQ,  IPPRS,  IPTMP 
I1TEGER«4  DEC0DE(200).  ICASREC 
IRTEGER*4  SPAIA(5),  SPAIB(5) 

IITEGER*4  FSTTAU,  LSTTAU,  SEQPLT,  PRSPLT,  TMPPLT 
IITEGER*2  EOF 

IITEGER*4  KREAD,  KWRITE,  KLOG,  KCTRL,  KFNT 
IITEGER4'2  ILCC,  lOVFL,  IPE,  ISR,  ILS 

REAL*4  0UTTAU(4800),  0UTSEQ(4800) ,  0UTPRS(4800) ,  0UTTMP(4800) 
real *4  taul8b(4800) ,saql8b(4800) 

CONNOR  /CAROl/  KREAD.  KWRITE,  KLOG,  KCTRL,  KFNT 
CONNOR  /CARDIA/  KPLOTS,  KSEQ,  KPRS.  KTNP 
CONNOR  /CARD2/  RVDS,  RSECT,  LASTWD,  DECODE 
CONNOR  /CARD2A/  SEQPLT , FSTTAU .  LSTTAU,  PRSPLT,  TMPPLT 
CONNOR  /CARD3/  ITHROT,  RURSP,  SPARA,  SPARB,  TESTW,  TESTV,  ISHIFT 
CONNOR  /CARD6/  RCASREC,  RLCC,  ROVFL,  RPE,  RSR,  RLS 
DATA  KREAD/7/,  KCTRL/8/.  KLOG/9/.  KWRITE/10/,  KFNT/0/,  KPL0T5/11/ 
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51 

52 

53 

54 

55 

56 

57 

58 

59 

60 
61 
62 

63 

64 

65 

66 

67 

68 

69 

70 

71 

72 

73 

74 

75 

76 

77 

78 

79 

80 
81 
82 

83 

84 

85 

86 

87 

88 

89 

90 

91 

92 

93 

94 

95 

96 

97 

98 

99 
100 
101 
102 

103 

104 


DATA  KSEQ/12/.  KPRS/13/.  KTMP/14/ 

DATA  ICASREC/O/,  EOF/0/,  IOOTREC/0/ 

DATA  IPTAU/0/,  IPSEQ/0/,  IPPRS/O/,  IPTMP/0/ 
data  ma8k/25S/,  kl8b/lS/.k8l»>b/16/.ma8)cl0/1023/ 
data  itotal/0/,  istot/O/ 
data  nskip/4/ 

C***** 

C*****  Open  the  I/O  units  and  filea 

C*****  Wait  until  later  to  open  the  output  dataaet  according  to  the 
C*****  desired  output  form  oi  the  file  (formatted  or  bin2u:y) . 

Also  open  the  plot  units,  if  needed,  in  the  S/R  C0ITR0L_CARDS . 

C***** 

OPEI (UIIT=kread , STATUS* ' OLD ' , BL0CKSIZE=6 12 , 
e  FORM* ' UIFORMATTED  * , CARRIAGECOITROL*  *  ROME ’ , 

«  ACCESS* ■SEQUEITIAL' .RECORDTYPE* 'VARIABLE' ) 

OPEI ( UIIT=kct r 1 , STATUS* ' OLD ' ) 

OPEI (UIIT=klog . STATUS* ' lEM ' . FORM* ' FORMATTED ' ) 

C**4>** 

C*****  Read  the  control  card  file 
CALL  COITROL.CARDS 
WRITE(*.42) 

42  FORMATClX,//, '  PROGRAM  IS  RUIIIIG.  PLEASE  WAIT.  RUIIIIG  TIME  IS 
•8-12  MIIUTES',//) 

C*****  Main  Loop 

C*****  Process  the  data  for  one  sampling  period  at  a  time  and  then  srite  it 
C*****  to  the  output  data  set.  You  may  need  to  use  more  than  one  cassette 
record  (ISECT)  for  each  sampling  period. 

Decode  GOODBITS  into  IWDS  output  words  in  the  2urray  OUTREC. 

(;**«*« 

10  COITIIUE 
OW  =  0 
IW  =  0 
IT  =  1 

DO  50  SAMPLIIG.PERIOD  =  1.  ISECT 

C*****  Process  the  next  cassette  record  for  this  sampling  period. 

CALL  lEWCARP(EOF) 

IF  (EOF  .IE.  0)  GO  TO  90 
ICASREC  =  ICASREC  *  1 

Decode  the  words  in  this  section  and  save  them  in  the  output 
C*****  array.  DECODE  stores  the  word  lengths  of  the  data. 

C*****  A  negative  value  in  DECODE  denotes  the  end  of  a 
C*****  cassette  record  (which  usually  means  a  sample  period) . 

15  COITIIUE 
IW  =  IW  +  1 
lUMBIT  *  DECODE(IW) 

IF  (lUMBIT  .GE.  0)  THEI 
OW  =  OW  +  1 


105 

OUTREC(OW)  =  IXTBIT(IUMBIT) 

106 

IF  (IW  .LE.  LASTWD)  GO  TO  15 

107 

«RITE(KL0G,20)  LASTWD,  IW 

108 

20 

F0RMATC/5X. 'PROGRAM  ERROR  -  IW  EXCEFI'S  LASTWD  AT  STMT#  15’, 

109 

e 

/5X. 'LASTWD  =’.14.’  IW  = ’ . 14 .5X . 'RUI  TERMIIATED’) 

no 

STOP  15 

111 

EID  IF 

112 

c******* 

113 

Check  the  value  of  all  the  test  words  in  this  section. 

114 

If  any  test  fails  -  ignore  all  output  words  decoded 

115 

c******* 

thus  far  and  start  decoding  for  section  1  again. 

116 

c******* 

117 

25  COITIHUE 

118 

IF 

(TESTW(IT)  .GT.  0)  THEI 

119 

IF  (TESTW(IT)  .LE.  OW)  THEI 

120 

I  =  TESTW(IT) 

121 

IF  (OUTREC(I)  .IE.  TESTV(IT))  THEI 

122 

WRITE (KLOG. 30)  TESTW(IT),  TESTV(IT).  OUTREC(I),  ICASREC 

123 

30 

F0RMAT1/5X. V.MUE  FOR  OUTPUT  WORD#’. 14. 

124 

« 

’ ,  TESTY ALUE  = ’ , 16 .  ’  .  ACTUAL  VALUE  = ’ , 16 , 

125 

fl 

’  -  CASSETTE  REC#’.I4) 

126 

GO  TO  10 

127 

EID  IF 

128 

IT  =  IT  +  1 

129 

GO  TO  25 

130 

EID  IF 

131 

EID  IF 

132 

133 

C*****  Testing  is  finished. 

134 

C*****  End  the  decoding  loop  -  repeat  ISECT  times. 

135 

136 

50  COITIIUE 

137 

138 

C*****  Unspan  the  words  which  spanned  sections  and  throw  out  any 

139 

C*****  word  at  position  ITHROT. 

140 

141 

lU 

=  1 

142 

I  = 

=  1 

143 

J  = 

:  1 

144 

IF 

(ITHROT  .IE.  0  .OR.  lUISP  .IE.  0)  THEI 

145 

60 

OUTREC(I)  =  OUTREC(J) 

146 

IF  (J  .IE.  ITHROT)  THEI 

147 

IF(J  .EQ.  SPAIA(IU))  THEI 

148 

65 

JJ  =  SPAIB(IU) 

149 

OUTREC(I)  =  OUTREC(JJ)  +  (0UTREC( J)*2**ISHIFT(IU) ) 

150 

lU  =  lU  +  1 

151 

J  =  JJ 

152 

EID  IF 

153 

70 

1  =  1  +  1 

154 

EID  IF 

155 

75 

J  =  J  +  1 

156 

IF  (J  .LE.  LASTWD)  GO  TO  60 

157 

EID  IF 

158 

46 


159 

160 
161 
162 

163 

164 

165 

166 

167 

168 

169 

170 

171 

172 

173 

174 

175 

176 

177 

178 

179 

180 
181 
182 

183 

184 

185 

186 

187 

188 

189 

190 

191 

192 

193 

194 

195 

196 

197 

198 

199 

200 
201 
202 

203 

204 

205 

206 

207 

208 

209 

210 
211 
212 


C*****  This  should  finish  one  sampling  period. 

C*****  Calculate  the  number  of  vords  to  be  written  out  to  the  disk 
C*****  eoid  write  out  to  the  disk  file  using  the  desired  format. 

80  COITIHUE 

OUTVDS  =  IWDS-IU¥SP-lfSECT-ITHROT+l 
lOUTREC  =  lOUTREC  +  1 
IF  (KFMT  .EQ.  0)  THEM 

WRITE(KWRITE)  (OUTREC(IO).  I0=1,DUTWDS)  !  Unformatted  output 
ELSE 

WRITE (KWRITE. 85)  (OUTREC(IO).  I0=1,0UTWDS)  !  Formatted  output 
85  F0RMAT(8I10) 

EID  IF 

C*****  Store  the  various  data  measurements  in  different  output  arrays  for 
€♦♦♦**  plotting.  When  the  arrays  are  full,  dump  them  out  on  disk. 

C*****  Only  write  every  4th  sampling  period  to  plotting  files 

C***** 

nskip  =  nskip  1 
if  (nskip  .It.  4)  go  to  10 
nskip  =  0 

IF  (FSTTAU  .WE.  0)  THEM 

DO  88  ITAU  =  FSTTAU,  LSTTAU 
IPTAU  =  IPTAU  +  1 
OUTTAU(IPTAU)  =  OUTREC(itau) 
taulsbCiptau)  =  jiand(outrec(itau) ,ma8kl0) 

88  COMTIMUE 

IF  (IPTAU  .EQ.  4800)  THE! 
itotal  =  itotal  *  iptau 
WRITE(KPL0T6)  OUTTAU 
write(klsb)  taulsb 
IPTAU  =  0 
EMD  IF 
end  if 

IF  (seqPLT  .IE.  0)  THE! 

IPSEQ  =  IPSEq  +  1 
OUTSEQ(IPSEq)  =  OUTREC(SEqPLT) 

Isbseq  =  jiand(outrec(seqplt) ,ma3kl0) 

8eqlsb(ipseq)  =  Isbseq 
IF  (IPSEq  .Sq.  4800)  THEI 
istot  =  istot  ipseq 
WRITE(KSEq)  OUTSEq 
write(ksl8b)  seqlsb 
IPSEq  =  0 
EID  IF 
end  if 

IF  (PRSPLT  .IE.  0)  THEI 
IPPRS  =  IPPRS  +  1 
OUTPRS(IPPRS)  =  0UTREC(26) 

IF  (IPPRS  .Eq.  4800)  THEI 
WRITE (KPRS)  OUTPRS 
IPPRS  =  0 
EID  IF 
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213 

214 

215 

O  4  « 
.A  W> 

217 

218 

219 

220 
221 
222 

223 

224 

225 

226 

227 

228 

229 

230 

231 

232 

233 

234 

235 

236 

237 

238 

239 

240 

241 

242 

243 

244 

245 

246 

247 

248 

249 

250 
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EID  IF 

IF  (TMPPLT  .IS.  0)  THEM 
IPTMP  =  IPTMP  +  1 
OUTTnPdPTHP)  =  0UTREC(27) 

IF  (IPTMP  .EQ.  4800)  THE! 

WRITE (KTMP)  OUTTMP 
IPTMP  =  0 
EID  IF 
EID  IF 

C***** 

C*****  Go  get  next  chunk  of  data. 

GO  TO  10 

C*****  End  of  file  condition,  wrap  things  up.  First  dump  shat’s  stored 
C*****  in  the  OUTTAU  array.  lote  that  there  may  be  "junk"  at  the  end  of 
C*****  this  array,  if  less  than  4800  new  points  wore  used. 

90  COITIIUE 

- 

c*****  beginning  of  modification  made  13-Aug-89 

c*****  the  output  arrays  are  set  to  zero  beyond  the  real  data  to  avoid 
c*****  "junk"  (referred  to  below)  at  the  end  of  the  plots. 

do  500  i=iptau,4800 

taulsb(i)=0.0 

outtau(i)=0.0 

500  continue 

c***** 

c*****  note  I  claim  ipseq,ipprs  and  iptmp  should  be  equal,  and  therefore 
enclose  them  in  a  single  DO  loop. 

c*e**4i 

do  501  i=ipseq,4800 

3eqlsb(i)=0.0 

outseq(i)=0.0 

outprs(i)=0.0 

outtmp(i)=0.0 

501  continue 

end  of  modification  made  13-Aug-89 
c*****--— ——————————————————————————— 


IF  (FSTTAU  .IE.  0)  then 
WRITE (KPL0T5)  OUTTAU 
itotal  =  itotal  +  iptau 
write(klsb)  taulsb 
End  if 

IF  (SEQPLT  .IE.  0)  then 
WRITE (KSEQ)  OUTSEQ 
istot  =  istot  ipseq 
write(kslsb)  seqlsb 
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267  end  if 

268  IF  (PRSPLT  .IE.  0)  WRITE(KPRS)  OUTPRS 

269  IF  (TMPPLT  .IE.  0)  WRITE(KTMP)  OUTTMP 

270  WRITE(KL0G.96)  ICASREC,  lOUTREC 

271  96  FORMATC  EMD  OF  DATA  EICOUITERED ’ / 

272  «  '  lUMBER  OF  CASSETTE  RECORDS  PROCESSED  =  ’,16/ 

273  «  ’  lUMBER  OF  OUTPUT  DATA  RECORDS  MRITTElf  =  ’,16) 

274  WRITE(KL0G,100)  ILCC,  lOVFL,  IPE,  ISR,  ILS 

275  100  FORMATC/’  lUMBER  OF  DOUBLE  LAST  CHARACTERS  =  ’,16/ 

276  e  ’  lUMBER  OF  OVERRUl  FLAGS  =  ’,16/ 

277  e  ’  lUMBER  OF  PARITY  ERRORS  =  ’,16/ 

278  fl  ■  lUMBER  OF  SHORT  RECORDS  =  ’.16/ 

279  e  ’  HUMBER  OF  LOW  SIGHALS  =  ’,16) 

280  WRITE(klog,43)  itotal.istot 

281  43  FORMATC IX, //, ’  ♦♦♦*  PROGRAM  IS  FIEISHED !!•**’, // 

282  C  ’  itau  =  ’,  ilO,’  iseq  =  iprs  =  itmp  =  ’,ilO) 

283  STOP 

284  EHD 

285  C***** 

286  C*********************************************************************** 

287  C*****  • 

288  C*****  SU8R0UTIHES  * 

289  C*****  * 

290  C*********************************************************************** 

291  C***** 

292  C***** 

293  C*********************************************************************** 

294  C*****  SUBROUTIHE  HXTBIT  * 

295  C*****  * 

296  c*****  Purpose  :  • 

297  c*****  To  translate  a  string  of  'I'  bit  integer  words  * 

298  C*****  one  word  at  a  time,  into  standard  32  bit  integer  word  * 

299  c*****  * 

300  C*****  Input  :  • 

1  A  string  of  bits  representing  a  string  of  integer  ♦ 

jvj2  C*****  words  of  varying  lengths  ♦ 

303  c*****  * 

304  C*****  Output  :  * 

306  C*****  A  32-bit  integer  word  containing  one  ’I’  bit  word  * 

306  c*****  from  the  input  string  ,  padded  to  the  left  with  binary  ♦ 

307  c*****  zeroes  if  necessary.  ♦ 

308  C*****  * 

309  * 

310  C*****  Usage  :  * 

311  C*****  A  call  to  this  entry  point  is  of  the  form  * 

312  C*****  IWORD  =  HXTBIT  (HUMBITS)  -  where  IWORD  is  • 

313  C*****  a  32-bit  integer  word  which  is  to  contain  the  next  * 

314  C*****  HUMBITS  bits  from  the  bit  string  being  processed.  * 

316  C*****  • 

316  C*****  * 

317  c*****  Errors  :  * 

318  C*****  If  HUMBITS  is  less  than  or  equal  to  zero  or  * 

319  c*****  If  HUMBITS  is  greater  than  31  * 

320  c*****  then  IVORD  is  set  to  -1  (all  binary  ones)  * 


321  C*****  li  the  total  ol  MUMBITS  in  all  calls  to  MXTBIT  • 

322  c*****  exceeds  IBITS  in  last  call  to  IIEIT.  ar  e’-ror  ♦ 

323  c*****  message  will  be  printed.  * 

324  c*****  * 

325  c*****  ♦ 

326  c*********************************************************************** 

327  c*****  BEWARE  IXTBIT  is  declared  as  a  function  subroutine  ***** 

328  c^**********************^*************** ******************************** 

329  C***** 

330  FUICTIOI  IXTBIT(IIBITS) 

331  IMPLICIT  IITEGER*2  (A-Z) 

332  IITEGER*2  MASKUSED(8) 

333  BYTE  IARRAY(256) 

334  IITEGER*4  IXTBIT,  AIS,  lEXTPART 

335  IITEGER-?4  !C?.SAD.  KWP.ITE,  KLOG,  KCTRL,  KFMT 

336  COMMOI  /CARDl/  KREAD,  KWRITE,  KLOG.  KCTRL,  KFMT 

337  COMMOI  /CARD4/  WIIX,BIIX,IARRAY 

338  SAVE  MASKIEG,  MASKUSED 

339  DATA  MASKIEG/ 'OOFF'X/ 

340  DATA  MASKUSED/ 'FF7F’X,  ’FF3F’X.  ’FFIF'X,  'FFOF'X, 

341  fl  'FF07’X,  'FF03’X.  'FFOl’X,  'FFOO’X/ 

342  C***** 

343  c*****  Check  for  errors  in  number  oX  bits  to  process. 

344  C***** 

345  IF  (IBITS. LE.O)  THEI  !  ERROR,  RETURI  -1 

346  WRITE(KL0G,66) 

347  66  FORMATC  IBITS  LESS  THAI  OR  EQUAL  TO  0  —  IXTBIT  SET  TO  -1’) 

348  IXTBIT  =  -1 

349  RETURI 

350  ELSE  IF (IBITS  .GT.  31)THEI  •  ERROR,  RETURI  -1 

361  WRITE (KLOG, 71) 

352  71  FORMAT ('IBITS  GREATER  THAI  31  --  IXTBIT  SET  TO  -1') 

353  IXTBIT  =  -1 

354  RETURI 

355  EID  IF 

356  C***** 

367  c*****  Initialize  AIS  to  0  and  PART  to  the  left-most  bits  of  lARRAY(WIIX) 

368  c*****  lARRAY(WIIX)  -  Current  8-bit  string  to  process. 

359  c*****  BIIX  -  The  number  of  bits  of  lARRAY(WIIX)  vhich  have  already 

360  c*****  been  used  (don't  «ant  to  use  them  again). 

361  C*****  BITWIT  -  Total  number  of  bits  needed  to  create  the  32-bit  word 

362  c***** 

363  AIS  =  0  !  lew  word  to  decode 

364  PART  =  lARRAY(WIIX) 

366  C***** 

366  C*****  First  mask  off  the  8  MSB's  that  make  PART  negative. 

367  c*****  Then  mask  off  any  bits  which  have  already  been  used. 

368  c***** 

369  PART  =  IIAID(PART,  MASKIEG) 

370  IF  (BIIX  .GT.  0)  THEI 

371  PART  =  IIAID(PART,MASKUSED(BIIX)) 

372  EID  IF 

373  PART  =  IISHFT(PART,BIIX) 

374  BITWIT  =  IBITS 


!  Total  bits  needed 
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404 
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(;«**** 

C*****  See  if  there  aure  enough  bite  in  this  word  to  get  the 
C*****  full  32-bit  word. 

C***** 

50  COITIIUE 

IF  (BITWHT  .GT.  8-BIIX)  THEM 

C*****  Mot  enough  bite  -  then  uee  all  of  this  word  and  then  come  bach 
here  to  get  more  bite  from  the  next  word. 

BITMOW  =  8  -  BIMX 
BITWMT  =  BITVMT  -  BITMOW 
VIMX  =  VIMX  1 
BIMX  =  0 

C*****  More  thain  enough  bite  -  uee  only  the  bits  needed. 

ELSE 

BITMOW  =  BITWMT 
BITWMT  =  0 

BIMX  =  BIMX  +  BITMOW 
IF  (BIMX  .EQ.  8)  THEM 
BIMX  =  0 
WIMX  =  WIMX  +  1 
EMD  IF 
EMD  IF 

C*****  Mow  have  some  or  all  of  the  bits  needed.  Right  justify  them. 

IF  (BITMOW  .LT.  8)  THEM 
MOWSHFT  =  8  -  BITMOW 
PART  =  IISHFT(PART,  -MOWSHFT) 

EMD  IF 

MEXTPART  =  PART 

Shift  bits  already  in  AMS  to  the  left  to  maXe  room  for  new  bits. 
C*****  Then  ’OR’  in  the  new  bits. 

Ceeeee 

AMS  =  JISHFT(AMS. (BITMOW)) 

AMS  =  I0R( AMS, MEXTPART) 

Ceeeee 

C*****  Are  more  bits  needed? 

C*****  If  yes;  then  get  the  next  iarray  word.  If  no:  return  AMS. 

C***** 

IF  (BITWMT. GT.O)  THEM 
PART  =  0 
MEXTPART  =  0 
PART  =  lARRAY(WIMX) 

PART  =  ITAMD(PART,  MASKMEG) 

GO  TO  50 
EMD  IF 
MXTBIT  =  AMS 
RETURM 
EMD 
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C**************************************************************************** 


c*****  * 

C*4I*«*  SUBROUTIIE:  lEWCARP  * 

C*****  PURPOSE;  To  read  the  Sea  Data  Reader  data  Tile.  Then  interpret  and  * 
C*****  remove  the  message  code  bits;  keep  only  the  data  bits.  Process  * 

C*****  one  cassette  record  at  a  time.  ♦ 

* 

************************* 


C***** 

SUBROUTIIE  lEWCARP (EOF) 

IMPLICIT  IITEGER*2  (A-Z) 

BYTE  DATABITS(256) ,  C0DEBITS(256) .  G00DBITS(200) 

IITEGER*4  KREAD,  KWRITE,  KLOG.  KCTRL,  KFMT.  ICASREC 
COMMOI  /CARDl/  KREAD.  KWRITE.  KLOG.  KCTRL.  KFMT 
COMMOI  /CARD4/  WIIX.  BIIX,  GOODBITS 
COMMOI  /CARD6/  ICASREC . ILCC .  lOVFL.  IPE.  ISR.  ILS 
SAVE  LAST_USED.  LSTWD.  IBLOCK.  MASKIEG 
DATA  IBLOCK/0/.  LSTWD/256/.  LAST_USED/256/ 

DATA  MASKTYPE/*0080'X/.  TYPEA/ ’0000*X/ .  MASKLCC/ ’0001 'X/ 

DATA  MASKPE/’0080’X/.  MASKTRACK/’OOOF’X/.  MASKSHDRT/ ’ 0040 ’ X/ 
DATA  MASKL0WSIG/’0020’X/.  MASKOVFL/ ’ 0040 ’ X/ 

DATA  MASKIEG/ ’OOFF’X/ 

DATA  ILCC/0/.  IOVFL/0/.  IPE/0/.  ISR/0/.  ILS/0/ 


C*****  Main  Processing  Loop 

C*****  The  data  file  is  a  binary  unformatted  file  of  512-byte  blocks 
C*****  Read  one  block  at  a  time. 


C**eee 


10  COITIIUE 
EOR  =  0 
IKEEP  =  0 
DO  12  L= 1.200 

GOODBITS (L)  =  0 
12  COITIIUE 

IF  (LAST.USED  .EQ.  266)  THEI 
READCKREAD.  EID=60.  ERR=15) 

C  (DATABITS(II).  CODEBITS(II) .  11=1,256) 

16  IBLOCK  =  IBLOCK  +  1 
LAST.USED  =  0 
EID  IF 

FRSTWD  =  LAST.USED  +  1 
DO  60  IWORD  =  FRSTWD.  LSTWD 
lOWHIBITS  =  CODEBITS (IWORD) 
lOWHIBITS  =  I I AID (lOWHIBITS.  MASKIEG) 

C***** 

C*****  Bits  numbered  0  to  16  with  LSB  =  0  and  MSB  =  15. 

C*****  Determine  if  a  data  word  (type  A  -  low)  or  a 
C*****  message  word  (type  B  -  hi)  using  bit  15. 

TEST  =  IIAID(MASKTYPE.  lOWHIBITS) 

20  COITIIUE 

IF  (TEST  .EQ.  TYPEA)  THEI  !  data  word  -  keep  the  necessary  bits 

C***** 
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483 

Ch«ck  to  see  it  its  the  last  data  vord  of  the  cassette 

record . 

484 

Zero  out  all  bits  except  bit  8;  If  hi,  then  last  character. 

486 

486 

TEST  =  IIAIDCMASKLCC.IOWHIBITS) 

487 

IF  (TEST  .EQ.  MASKLCC)  THE! 

488 

IF  (IKEEP  .EQ.  0)  THEM  !  Make  sure  there  aren’t 

two  in  a  row 

489 

WRITE(KL0G,24)  IWORD,  IBLOCK,  ICASREC 

490 

24 

FORMATC  DOUBLE  LCC  at  word  =  ',16. 

491 

6 

■  of  block  =  ’,16,’  (ICASREC  =  ’.16.’) 

’) 

492 

ILCC  =  ILCC  +  1 

493 

GO  TO  SO 

494 

EID  IF 

495 

EOR  =  1  !  end  of  record  encountered 

496 

EID  IF 

497 

498 

Check  to  see  if  there  is  an  overrun  flag,  indicating  at 

least  one 

499 

missed  scan  of  data.  Zero  out  all  bits  except  bit  14. 

500 

c***** 

If  hi,  then  overrun  has  occurred. 

501 

502 

TEST  =  IIAID(MASKOVFL,IOWHIBITS) 

503 

IF  (TEST  .EQ.  MASKOVFL)  THEI 

504 

WRITE (KLOG, 26)  IWORD.  IBLOCK,  ICASREC 

505 

25 

F0RMAT('  OVERRUI  FLAG  at  word  =  ’,16, 

506 

e 

’  of  block  =  ’.16,’  (ICASREC  =  ’,16,’)’) 

507 

lOVFL  =  lOVFL  +  1 

508 

EID  IF 

509 

510 

Keep  the  data  dits  ,  get  rid  of  the  code  bits 

511 

512 

IKEEP  =  IKEEP  +  1 

513 

G00DBITS( IKEEP)  =  DATABITS( IWORD) 

514 

515 

c***** 

Processing  Type  B  -  message  words 

516 

517 

ELSE 

518 

lOWLOWBITS  =  DATAB ITS (IWORD) 

519 

lOWLOWBITS  =  IIAIDdOWLOWBITS,  NASKIEG) 

520 

521 

Test  for  pariety  errors.  If  bit  7  is  hi,  errors  occurred. 

522 

623 

30 

TEST  =  IIAID(MASKPE.  lOWLOWBITS) 

524 

IF  (TEST  .EQ.  MASKPE)  THEI  !  Parity  error  occurred 

525 

TEST  =  IIAID(MASKTRACK,  lOWLOWBITS) 

526 

WRITE(KL0G,36)  TEST.  IWORD,  IBLOCK .ICASREC 

627 

36 

F0RMAT(’  PARITY  ERROR  =  ’.16,’  at  word  =  ’,16, 

528 

« 

’  of  block  =  ’.16,’  (ICASREC  =  ’.16.’)’) 

529 

IPE  =  IPE  1 

630 

EID  IF 

531 

532 

Test  for  a  short  record.  If  bit  6  is  hi,  then  yes. 

533 

534 

TEST  =  IIAID(MASKSHORT,  lOWLOWBITS) 

536 

IF  (TEST  .EQ.  MASKSHORT)  THEI  !  Record  was  short 

536 

WRITE(KL0G.40)  IWORD,  IBLOCK.  ICASREC 

637 

40 

638 

« 

639 

640 

541 

542 

543 

c***** 

544 

c***** 

545 

546 

547 

548 

46 

549 

e 

550 

551 

552 

c***** 

553 

554 

555 

556 

557 

558 

559 

560 

561 

562 

563 

Cesses 

664 

Cesses 

566 

Cesses 

666 

Cesses 

567 

568 

669 

670 

671 

672 

573 

50  ( 

674 

Cesses 

576 

Cesses 

676 

Cesses 

577 

] 

678 

( 

579 

Cesses 

680 

Cesses 

681 

Cesses 

682 

60  1 

683 

1 

684 

1 

686 

66  ] 

686 

1 

687 

1 

688 

Cesses 

689 

Cesses 

690 

Cesses 

FORMATC  SHORT  RECORD  at  word  =  *,16, 

’  ol  block  =  '.16.'  (ICASREC  =  '.16,')') 
ISR  =  ISR  -K  1 
IF  (IKEEP  .IE.  0)  EOR  =  1 
EID  IF 


TEST  =  IIAID(NASKLOWSIG.  lOVLOWBITS) 

IF  (TEST  .EQ.  NASKLOUSIG)  THEI  !  Signal  strength  was  weak 
URITE(KL0G.45)  IVORD.  IBLOCK.  ICASREC 
FORNATC'  weak  SIGIAL  encountered  at  word  =  ',  16. 

'  of  block  =  '.16.'  (ICASREC  =  ',16,')') 

ILS  =  ILS  +  1 
EID  IF 


TEST  =  IIAID(MASKOVFL.IOWHIBITS) 

IF  (TEST  .EQ.  MASKOVFL)  THEI 

HRITE(KL0G,2S)  IWORD,  IBLOCK.  ICASREC 
lOVFL  =  lOVFL  +  1 
EID  IF 
EID  IF 


IF  (EOR  .IE.  0)  THEI 
LAST.USED  =  IWORD 
WIIX  =  1 
BIIX  =  0 
RETURI 
EID  IF 


LAST.USED  =  266 
GO  TO  12 


EOF  =  -1 

WRITE (KLOG, 66)  IBLOCK 
F0RMAT(//6X, 'EID  OF  FI 
RETURI 
EID 
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591  SUBROUTIIE  COITROL.CARDS 

592  IITEGER*2  IDI,  IDS(5) ,  IWDS 

593  IITEGER*4  IVALS(IO),  ISECT 

594  IITEGER*4  lEGlCT,  DEC0DE(200).  IW 

595  IITEGER*4  TESTW(20),TESTV(20).  IT 

596  IITEGER*4  ITHROT,  SPAIA(5).  SPA*B(5).  lU 

597  IRTEGER*4  LASTVD,  lUISP 

598  IITEGER*4  FSTTAU,  LSTTAU,  SEQPLT,  PRSPLT,  TKPPLT 

599  IITEGER*2  ISHIFTdO) 

600  IITEGER*4  KREAD,  KWRITE,  KLOG,  KCTRL,  KFMT 

601  IITEGER+4  KPL0T5,  KSEQ,  KPRS,  KTMP 

602  COMMOI  /CARDl/  KREAD.  KWRITE.  KLOG.  KCTRL.  KFMT 

603  COMMOI  /CARDl A/  KPL0T5.  KSEQ.  KPRS.  KTMP 

604  COMMOI  /CAR02/  IWDS.  ISECT.  LASTVD.  DECODE 

605  COMMOI  /CARD2A/  SEQPLT.  FSTTAU.  LSTTAU.  PRSPLT.  TMPPLT 

606  COMMOI  /CARD3/  ITHROT.  lUISP.  SPAIA.  SPAIB.  TESTW.  TESTV,  ISHIFT 

607  DATA  IDS/*IW'.  ’WL’.  'SV*.  ’US’,  'WF’/ 

608  ..ATA  IW/0/,  ItGlCT/O/,  LASTWD/0/ 

609  DATA  TESTW/20*0/.  TESTV/20*0/.  IT/0/ 

610  DATA  ITHROT/O/,  SPAIA/5*0/.  SPAIB/5*0/.  IU/0/,  IUKSP/0/ 

611  C***** 

612  c*****  Read  in  the  control  parameters  2md  set  error  options. 

613  C***** 

614  WRITE (KLOG, 10) 

615  10  F0RMAT(5X,'  COITROL  CARDS  FOR  DECODIIG’/) 

616  C***** 

617  c*****  Reading  loop  for  the  the  control  C2a'ds 

618  C***** 

619  20  COITIIUE 

620  READ(KCTRL,22,EKD=66)  IDI.  (IVALS(I) ,1=1 , 10) 

621  22  F0RMAT(A2,3X,10I5) 

622  WRITE (KLOG, 24)  IDI,  (IVALS(I) . 1=1 , 10) 

623  24  F0RMAT(/5X.A2.2X,10I10) 

624  C***** 

625  C*****  Check  for  a  'lUMBER  OF  WORDS’  (IW)  card. 

626  c*****  ISECT  -  The  number  of  cassette  records  used  to  hold 

627  C*****  all  the  data  from  one  sampling  period.  Usually  this 

628  C*****  is  one. 

629  c*****  IWDS  -  lumber  of  vords  to  be  decoded,  this  does  not 

630  c*****  include  the  -1  word. 

631  C***** 

632  IF  (IDI  .EQ.  IDS(l))  THEI 

633  IWDS  =  IVALS(l) 

634  ISECT  =  IVALS(2) 

636  IF  (ISECT  .EQ.  0)  ISECT  =  1 

636  C***** 

637  c*****  Check  for  a  word  length  (WL)  card. 

638  c*****  Save  the  word  lengths  in  array  ’DECODE’  -  Ignore  zero  values 

639  c*****  -1  on  this  card  flags  the  end  of  the  cassette  record. 

640  C***** 

641  ELSE  IF  (IDI  .EQ.  IDS(2))  THEI 

642  DO  30  I  =  1,  10 

643  IF  (IVALS(I)  .IE.  0)  THEI 

644  IF  (IVALS(I)  .LT.  0)  lEGlCT  =  lEGlCT  +  1 
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698 


I¥  =  IW  +  1 
DECODE(IW)  =  IViLS(I) 

EID  IF 
30  COITIIUE 
C***** 

c*****  Check  for  a  ’SPECIAL  VALUE’  (SV)  control  card. 

C*****  Sava  the  testwords  in  TESTW  and  the  testvalues  in  TESTV. 

C*****  Ignore  negative  and  zero  values  for  testvords. 

ELSE  IF  (IDI  .EQ.  IDS(3))  THEM 
DO  40  I  =  1,  10,  2 

IF  (IVALS(I)  .GT.  0)  THEI 
IT  =  IT  +  1 
TESTW (IT)  =  IVALS(I) 

TESTV (IT)  =  IVALS(I+1) 

EID  IF 
40  COITIIUE 
C***** 

C*****  Check  for  an  ’UlSPAI’  (US)  vorda  control  card. 

C*****  First  value  is  vord  to  be  thrown  out  (0=none) . 

C*****  Other  pairs  of  values  are  words  to  be  unspeinned. 

C*****  Save  the  values  in  SPAIA  and  SPAIB.  Ignore  zero  values. 

ELSE  IF  (IDI  .EQ.  IDS (4))  THEI 
ITHROT  =  IVALS(l) 

DO  SO  1=2, 9, 2 

IFdVALSd)  .GT.  0)  THEI 
lU  =  lU  +  1 
SPAIA(IU)  =  IVALSd) 

SPAIB  (lU)  =  IVALSd+l) 

EID  IF 
50  COITIIUE 

Ceeee*  Check  for  a  ’WRITE  FORMAT’  (WF)  control  card  for 
C*****  output  data  on  unit  KWRITE. 

C*****  IF  0  ->  UIFORMATTED  IF  1  ->  FORMATTED 
C*****  Open  the  output  file  accordingly. 

C*****  Save  the  word  nuabers  of  the  first  and  last  travel  times  for  plotting. 
C*****  Open  all  plotting  file  units  if  needed. 

ELSE  IF  (IDI  .EQ.  IDS (5))  THEI 
KFMT  =  IVALS(l) 

IF  (KFMT  .EQ.  0)  THEI 

OPEI (UIIT=kwr ite , STATUS= ’ lEW ’ , F0RM= ’ UIFORMATTED ’ ) 

ELSE 

OPEI ( UIIT=kwr ite . STATUS= ’ lEW ’ , F0RM= ’ FORMATTED ’ ) 

EID  IF 

SEQPLT  =  IVALS(2) 

IF  (SEQPLT  .IE.  0)  than 

0PEI(UIIT=k8eq,  STATUS= ’ lEW ’ ,  FORM=’ UIFORMATTED’) 

OPEI (UIIT=kslsb , STATUS= ’ lEW ’ ,F0RM= ’ UIFORMATTED ’ ) 
end  if 

FSTTAU  =  IVALS(3) 

LSTTAU  =  IVALS(4) 
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IF  (FSTTAU  .IE.  0)  then 

0PEI(UIIT=kplot6.  STATUS='IEH' ,  F0IIM= ’ UIFORMATTED ' ) 
OPEI (UIIT=klab , STATUS= ' lEH ' , F0IIM= ' UIFORMATTED ' ) 
end  11 

PRSPLT  =  IVALS(6) 

IF  (PRSPLT  .IE.  0) 

«  OPEI(UIIT=kpra.  STATUS= *IEW’ ,  FORM= ’UIFORMATTED’ ) 

TMPPLT  =  IVALS(6) 

IF  (TMPPLT  .IE.  0) 

e  OPEI(UIIT=ktBp,  STATUS=’IEV’.  FORM= ’ UIFORMATTED ’ ) 

C***** 

C*****  H  control  card  ia  none  of  the  above  then  it  ia  invalid. 
C*****  So  print  a  meaaage  and  teminate  the  run. 

C***** 

ELSE 

WRITE(KL0G.56) 

65  F0RMAT(/5X, ’PRECEEDIIG  COITROL  CARD  HAS  AI  IIVALID  I.D.’, 
C  ’  -  RUI  TERMIIATED’) 

STOP  56 
EID  IF 
GO  TO  20 

C*****  Laat  control  card  haa  been  read;  Set  par2uneter8. 

66  COITIIUE 
LASTWD  =  IW 
lUISP  =  lU 

C***** 

C**ee*  If  there  are  vorda  to  be  unapanned,  get  the  multiplicative 
C*****  valuea  from  the  aaaociated  eord  lengtha.  Aaaume  normal  bit 
C*****  order,  LSB’a  to  the  right  (higher  word  #) . 

Iota  that  the  DECODE  array  atill  containa  the  ITHROT  words 
C*****  so  that  IVD  is  calculated  to  skip  over  these  values. 

C***** 

IFdUISP  .IE.  0)  THEI 
DO  70  I=1.IUISP 
IWD  =  SPAIB(I)  +  I 
ISHIFT(I)  =  DECODE(IWD) 

70  COITIIUE 

EID  IF 

C***** 

C*****  Check  for  control  card  consistency. 

76  COITIIUE 

IF  (ISECT  .IE.  lEGlCT)  THEI 
tfRITE(KL0G,78)  ISECT,  lEGlCT 
78  F0RMAT(/6X, ’IW  CARD  SPECIFIES’ ,16, 

•  '  SECTIOIS  BUT  WL  CARDS  COITAII’,15, 

«  ’  SECTIOI  EID  MARKERS  (lEG)  -  RUI  TERMIIATED’) 

STOP  78 
EID  IF 
80  COITIIUE 

I  =  IW  -  lEGlCT 
IF  (IWDS  .IE.  I)  THEI 
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753  WRITE(KL0G,82)  IWDS,  I 

754  82  F0IWAT(/5X, 'IW  CARD  SPECIFIES', 15. 

755  e  ’  WORDS  BUT  WL  CARDS  COITAII',15, 

756  e  ’  (lOI-IEGATIVE  lOI-ZERO)  WORDS  -  RUI  TERMIIATED’) 

757  STOP  82 

758  EID  IF 

759  C***** 

760  Control  caurds  vere  okay.  Return  to  main  program. 

761  C***** 

762  85  COITIIUE 

763  RETURI 

764  EID 
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3.2  PUNS_MAY88.FOR 

1  c******* 

2  c*******  PUIS_MAY88.F0R 

3  c******* 

4  c*******  THIS  PROGRAM  WILL  PRODUCE  HISTOGRAMS  AHD/OR  LISTIHGS 

5  c*******  OF  TRAVEL  TIME  BURSTS  OF  A  SPECIFIED  RAIGE  OF  SAMPLES. 

6  C*******  THE  LISTIHGS  ARE  EITHER  II  IITEGER  COUITS  OR  COMVERTED  TO  THE 

7  C*******  DECIMAL  EQUIVALEITS.  THREE  TYPES  OF  HISTOGRAMS  CAI  BE 

8  C*******  PRODUCED:  1)  LEVEL-1  (LI)  ARE  IIDIVIDUAL  PLOTS  OF  EACH 

9  c*******  SAMPLIIG  PERIOD.  2)  LEVEL-2  (L2)  ARE  PLOTS  OF  GROUPS  OF 

10  c*******  RECORDS.  SAMPLED  AT  A  GIVEI  IITERVAL.  3)  LEVEL-3  PRODUCES  A 

11  c*******  HISTOGRAM  OF  ALL  RECORDS  WITHII  THE  RAIGE  SPECIFIED.  A  LEVEL-3 

12  C*******  PLOT  IS  PRODUCED  EACH  AUTOMATICALLY  WHEI  THE  PROGRAM  IS 

13  C*******  EXECUTED. 

14  C*******  THE  USER  SPECIFIES  THE  TOTAL  RAIGE  OF  RECORDS  TO  PROCESS. 

15  C*******  IF  LEVEL-2  PLOTS  ARE  TO  BE  MADE,  THE  USER  MUST  ALSO  SPECIFY  THE 

16  C*******  HUMBER  OF  RECORDS  TO  USE  FOR  A  HISTOGRAM  (GRPSIZ)  AID  THE 

17  c*******  HUMBER  OF  RECORDS  TO  SKIP  BETWEEI  COISECUTIVE  PLOTS  (RATE) . 

18  c*******  THE  UPPER  AID  LOWER  BOUHDS  OF  HISTOGRAMS  ARE  ALSO  SPECIFIED  BY 

19  c*******  THE  USER,  THUS  EILARGEMEHTS  OF  A  lARROWER  RAIGE  CAI  BE  MADE. 

20  C*******  IF  THERE  ARE  ADDITIONAL  SENSORS,  SUCH  AS  PRESSURE,  THEIR  VALUES 

21  c*******  II  COUITS  ARE  PRINTED  WHEI  SAMPLES  ARE  LISTED.  IF  THERE  ARE  2 

22  c*******  TT  DETECTORS,  BOTH  WILL  BE  PLOTTED. 

23  c******* 

24  C-*******  FORTRAI  UNIT  NUMBERS  DESIGNATED  AS  FOLLOWS: 

25  C*******  KR  (UNIT  S)  CONTROL  CARD  INPUT  FILE 

26  C*******  KW  (UNIT  6)  PRINTER  OUTPUT  LOG  FILE  OF  HISTOGRAMS 

27  C*******  KWDEC  (UNIT  7)  FLOATING  POINT  OUTPUT  OF  SCALED  DATA 

28  C*******  KWINT  (UNIT  8)  INTEGER  OUTPUT  OF  SCALED  DATA 

29  C*******  KRBUIS  (UNIT  9)  IITEGER  INPUT  OF  BUIS.REV82  DATA 

30  c******* 

31  c******* 

32  lAMELIST/CARDl/  HEADR 

33  IAMELIST/CARD2/  ITT.  TTYPE 

34  IAMELIST/CARD3/  IWORDS,  LBURST,  LBFST,  RDFMT 

35  IAMELIST/CARD4/  ISEH,  SENSOR,  SWDIO 

36  IAMELIST/CARD6/  SFl .  SF2 

37  IAMELIST/CAR06/  LBIDA,  UBIDA,  LBIDB,  UBIDB 

38  IAMELIST/CARD7/  START,  EID,  RATE.  GRPSIZ.  SEQIIC 

39  IANELIST/CARD8/  OPTI 

40  COMMOI  FREQ, LCT.UCT, LEND, UBID.IUMLI.IUMPL.SF, RATE. GRPSIZ 

41  COMMOI/IUMBR/ITr, LBFST. LBLST, TTYPE 

42  COMMOI/UIIT/KR,  KW,  KWDEC.  KWIIT,  KRBUIS,  RDFMT 

43  CRARACTER«60  HEADR 

44  CHARACTER'S  TTYPE(2) 

46  CHARACTER*2  SEIS0R(3),  0PTI(4).  PR.  TP,  AM 

46  CHARACTER*2  DE.  IIT,  LI.  L2 

47  IITEGER*4  FREQ (55. 6),  FREQ A (55),  FREqB(55) 

48  IITEGER*4  LCT(6),  UCT(6),  LCTA,  LCTB,  UCTA,  UCTB 

49  IITEGER*4  ITT 

50  IITEGER*4  IWORDS.  LBURST,  LBFST.  RDFMT 

61  IITEGER*4  ISEH,  SWDI0(3) 

62  IITEGER*4  LBID(2) ,  UBID(2).  LBIDA,  LBIDB,  UBIDA,  UBIDB 
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IITEGER*4  START,  EID,  RATE.  RATCTR,  GRPSIZ,  GRPEID,  SEQIIC 

IITEGER*4  DESV,  IISV,  GRLl,  GRL2 

IITEGER*4  PRSI , TPSI , ANSI , PRWDIO , TPWDIO , ANWDIO 

IITEGER*4  LEVELl,  LEVEL2,  LEVELS 

IITEGER*4  TO,  FROM 

IITEGER*4  IUMLI(2),  IUMPL{2) .  lUMPLA,  lUMPLB 
IITEGER*4  11(100),  OUT(IOO),  RECII,  RECOUT,  SEQIO 
IITEGER«4  PRESS,  TEMP,  AMBIS 
IITEGER*4  BOTA,TOPA.BOTB,TOPB 
REAL*4  SFl,  SF2,  SF(2) 

REAL*4  DOUT(IOO).  DLBIDA,  OUBIDA,  DLBIDB,  DUBIDB 
EQUI V ALEICE  ( FREQ (1.1). FREQ A ( 1 ) ) , (FREQ (1.2). FREQB ( 1 ) ) . 

6  (LCT(l)  ,i.CTa)  ,(LCT(2)  .LCTB), 

e  (UCT(l) ,UCTA) ,(UCT(2),UCTB). 

fl  (LBID(1).LBI0A),(LBID(2).LBIDB). 

e  (UBID(1).UBIDA),(UBID(2).UBIDB). 

•  (lUMPLd)  .lUMPLA) .  (IUMPL(2)  .lUMPLB)  , 

e  (SF(1).SF1).(SF(2).SF2) 

PARAMETER  (DE=’DE*  ,HT=’II'  ,L1=‘L1 '  ,L2= 'L2  ’  ) 

PARAMETER  ( PR= ' PR ’ . TP= ' TP ’ . AM= ' AM  * ) 

DATA  KR/5/.  KW/6/,  KMDEC/7/,  KWIIT/8/.  KRBUIS/9/ 

DATA  RECII/0/ . RECOUT/0/ . SEgiO/-!/ . RATCTR/O/ 

DATA  DESW/0/ , IISM/0/ ,GRLl/0/ , GRL2/0/ 

DATA  PRESS/-99/ . TEMP/-99/ . AMBIS/-99/ . ITT/1/ 

DATA  TTYPE/2*'  ’/,SEIS0R/3*’  V.SWDIO/O.O.O/ 

DATA  CFTM  /4*'  7 


C*******  SOME  OF  THE  VARIABLES: 

C*******  GRPSIZ  -  THE  lUNBER  OF  COISECUTIVE  BURSTS  TO  BE  SAMPLED 
C*******  rate  -  THE  lUMBER  OF  BURSTS  SKIPPED  BETWEEI  GROUPS 
C***«**4>  SEQUEICE  lUNBER  IICRENEIT: 

C**««***  1  =  16  Mil  SAMPLIIG 

C*****4i«  2  =  30  Mil  SAMPLIIG 

C*******  4  =  60  Mil  SAMPLIIG 

C***«««*  8  =  120  Nil  SAMPLIIG 

C**««*** 


c*******  TYPICALLY  SF1=20480.0,SF2=20480.0 

C*******  LOWER  AID  UPPER  BOUIDS  ARE  SPECIFIED  II  TERMS  OF  COUNTS, 
C*******  HEICE,  TO  FIID  ALLOWED  RANGE  II  EIGIIEERIIG  UNITS,  DIVIDE 
C*******  COUNTS  BY  SCALE  FACTOR:  E.G.  202752. /20480.=  9.9  SECONDS 
C***«**«  ITT  -  lUMBER  OF  DIFFERENT  TRAVEL  TINE  DETECTORS  (TTYPE)  USED. 
C*******  IWORDS  -  lUMBER  OF  WORDS  PER  BUIS  OUTPUT  RECORD  (INCLUDING 
C**«****  SEQ#,  LBURST, PRESS, TEMP, ANB) 

C*******  RDFMT  -  FORMAT  OF  INPUT  DATASET:  IF  1  =>  FORMATTED  READ 
C*******  IF  0  =>  BINARY  READ 

c******«  INITIALIZE  COMMON  VARIABLES 


DO  16  I  =  1,  6 
DO  15  J  =  1,55 
FREQd.I)  =  0 
15  COITIIUE 
UCT(I)  =  0 
LCT(I)  =  0 
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16  COMTIMUE 

WRITE (*.42) 

42  FORMATdX,//,  '  THE  PROGRIM  IS  ROW  RUIIIIG!  ' 

«'  THIS  MAY  TAKE  A  FEW  MIIUTES  SO  SIT  BACK  AID  RELAX.',/) 

C*****4>* 

c*******  read  aid  prut  THE  COITROL  CARD  IIFORMATIOI 

READ  (KR,IML=CAR01) 

READ  (KR,INL=CARD2) 

READ  (KR.INL=CAR03) 

READ  (KR,IML=CAR04) 

READ  (KR.MNLsCARDS) 

READ  (KR,INL=CARD6) 

READ  (KR,IML=CARD7) 

READ  (KR,IML=CARD8) 

C*******  OPEI  THE  IIPUT  BUIS  DATA  SET  FOR  READIIG  DEPEIDIIG  01  THE 

C*******  FORMAT  OF  THE  DATA 

C*«***t« 

IF  (RDFMT  .EQ.  0)  THEI 

OPEI(UIIT=KRBUIS.  STATUS= ' OLD ’ ,  FORM= 'UIFORMATTED ' ) 

ELSE 

OPEI(UIIT=KRBUIS,  STATUS= ' OLD ' .  FORM= ' FORMATTED ' ) 

EID  IF 

C******* 

C*******  RESET  VARIABLES,  IF  lECESSARY,  TO  MAKE  SURE  THEY  ARE  CORRECT 

C******* 

IF  (EID  .LT.  1)  EID  =  2**30 
IF  (GRPSIZ  .LE.  0)  GRPSIZ  *  1 
IF(SEQIIC  .LE.  0)  SEQIIC  =  1 

C***««** 

c*******  SET  OPTIOI  SWITCHES  FOR  THE  DESIRED  OUTPUT  TYPES 
C******* 

DO  17  I  =  1,  4 

IF  (OPTI(I)  .EQ.  IIT)  IISW  =  1 
IF  (OPTI(I)  .EQ.  DE)  DESW  =  1 
IF  (OPTI(I)  .EQ.  LI)  GRLl  =  1 
IF  COPTI(I)  .EQ.  L2)  GRL2  =  1 
17  COITIIUE 

IFdSEI  .EQ.  0)  GO  TO  26 
DO  25  I  =  1.  3 

IFCSEISORd)  .IE.  PR)  GO  TO  23 
PRSI  =  1 

PRWDIO  =  SWDIO(I) 

GO  TO  25 

23  IF(SEISOR(I)  .IE.  TP)  GO  TO  24 
TPSI  =  1 

TPWDIO  =  SWDIO(I) 

GO  TO  25 

24  IFCSEISORd)  .IE.  AM)  ZZ  TC  2C 

AMSI  =  1 

AMWDIO  =  SWDIOd) 


161 

162 

163 

164 

165 

166 

167 

168 

169 

170 

171 

172 

173 

174 

175 

176 

177 

178 

179 

180 
181 
182 

183 

184 

185 

186 

187 

188 

189 

190 

191 

192 

193 

194 

195 

196 

197 

198 

199 

200 
201 
202 

203 

204 

205 

206 

207 

208 

209 

210 
211 
212 

213 

214 


25  COITIIUE 
C******* 

C*******  DETERNIIE  THE  REMAIIIIG  COITROLLIIG  VARIABLES 
C*******  THESE  ARE  BASED  01  THE  TYPE  OF  HISTOGRAMS  WAITED 

26  GRPEID  =  RATE  +  GRPSIZ 
LEVELS  =  (GRLl  +  GRL2)  *2+1 
LEVEL2  =  (GRLl  +  GRL2)  ♦2-1 
LEVEL 1  =  GRLl 

LBLST  =  LBFST  +  LBURST  -  1 

IFdTT  .GT.  1)  LBLST  =  LBFST  +  (2^LBURST)  -  1 

C*******  WRITE  HEADER  IIFO  TO  LOG 

WRITE(KW.301)  HEADR 
301  FORMAT('l' .A60) 

WRITE(KW.303)  (TTYPE(I) . 1=1 .ITT) , (SEISOR(II) ,11=1 .3) 

303  FORMATC'O*,'  TYPES  OF  SEISORS  USED:  *.5(A4.2X)) 

WRITE (KW, 306)  TTYPE(l) 

306  FORMATCO’ ,A4. '  DETECTOR:  ■) 

IFdTT  .GT.  1)  WRITE(KW,307)  TTYPE(2) 

307  FURMAT(’+*,T60.A4,'  DETECTOR:  ') 

WRITE(KW.309)  SFl 

309  FORMAT (6X, ’SCALE  FACTOR  A  =  ’,F16.5) 

IFdTT  .GT.  1)  WRITE(KW,311)  SF2 
311  FORMAT(’+’ ,T60,5X, ’SCALE  FACTOR  B  =  ’.F16.S) 

WRITE (KW. 3 13)  LBIDA.UBIDA 
313  F0RMAT(6X, ’LBIDA  =  ’ ,I8,3X, ’UBIDA  =  ’,18) 

IFdTT  .GT.  1)  WRITE(KW,315)  LBIDB.UBIDB 
315  F0RMAT(’+’,T60.5X.’LBIDB  =  ’ ,18. 3X, ’UBIDA  =  ’,18) 

WRITE  (KW.317)  START. EID, RATE, GRPSIZ, SEQIIC 
317  F0RMAT(/10X, ’REC  #’,16.’  THRU  ’,16.’  WILL  BE  PROCESSED’, 

C  //lOX, ’SAMPLE  RATE  =’ .16, 5X, ’GROUP  SIZE  =’,I6, 

«  //lOX, ’SEQUEICE  10.  IIC.  =  ’.16) 

WRITE  (KW,319)  (OPTI(I) ,1=1 .4) 

319  F0RMAT(/10X. ’OPTIOIS  =  ’.4(A2.2X)) 

c*******  FIGURE  THE  RAIGE  OF  EACH  GRAPH  LIIE  *  THE  #  OF  LUES  /  GRAPH 

DO  30  I  =  l.ITT 
UBRIGE  =  UBID(I)  -  LBID(I) 
lUMPL(I)  =  UBRIGE  /  60  +  1 
lUMLI(I)  =  UBRIGE  /  lUMPL(I)  +  1 
30  COITIIUE 

COIVERT  THE  UPPER  AID  LOWER  BOUIDS  TO  DECIMAL  SECOIDS 

(;*«««*♦* 

DLBIDA  =  LBIDA  /SFl 
DUBIDA  =  UBIDA  /  SFl 
IFdTT  .EQ.  1)  GO  TO  36 
DLBIDB  =  LBIDB  /  SF2 
DUBIDB  =  UBIDB  /  SF2 

c*******  read  THE  IIPUT  DATA  FILE,  CHECK  FOR  EOF,  IICREMEIT  COUITER 
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215  c******* 

216  36  COITIIUE 

217  CALL  RDBUISdVOROS.II) 

218  IF  (11(1)  .EQ.  -1)  GO  TO  1000 

219  RECII  =  RECII  +  1 

220  c******* 

221  C*******  CHECK  WHETHER  RECORD  SHOULD  BE  PROCESSED 

222  C**«««**  A)  OUTSIDE  RAIGE  OF  RECORDS  TO  PROCESS 

223  C******* 

224  IF  (RECII  .LT.  START)  GO  TO  35 

226  IF  (RECII  .GT.  EID)  GO  TO  1100 

226  c******* 

227  C*******  B)  DQIIG  LEVEL- 1  OR  LEVEL-3  PLOTS,  USE  THIS  RECORD 

228  C******* 

229  IF  (RATE  .LT  1)  GO  TO  40 

230  C^*^**** 

231  C*******  C)  DOUG  OILY  A  LEVEL-2  PLOT.  CHECK  IF  WITHII  GROUP 

232  C*******  TO  PROCESS  OR  TO  SKIP.  IF  II  GROUP  TO  PROCESS, 

233  C*******  DO  YOU  HAVE  THEM  ALL?  IF  SO.  THEI  RESET  COUITER. 

234  C******* 

236  RATCTR  =  RATCTR  +  1 

236  37  IF  (RATCTR  .LT.  RATE)  GO  TO  35 

237  IF  (RATCTR  .LT.  GRPEID)  GO  TO  40 

238  RATCTR  =  RATCTR  -  RATE 

239  c******* 

240  C*******  GEIERATE  A  LEVEL-  2  (GROUP)  GRAPH  IF  REQUESTED 

241  C******* 

242  IF  (GRL2.Eq.O)  GO  TO  37 

243  TO  =  RECII  -  1 

244  FROM  =  RECII  -  GRPSIZ 

245  CALL  FREQGR  (LEVEL2 .FROM.TO) 

246  GO  TO  37 

247  c******* 

248  C*******  CHECK  FOR  SEQUEICE  ERRORS  II  THE  FILE 

249  C*******  AID  REIAME  THE  DATA  VALUES 

260  C*******  ASSUMES  THAT  SEQIO  IS  FIRST  WORD  AID  THE  TT'S  ARE  GROUPED 

251  c******* 

252  40  COITIIUE 

253  IF  (11(1)  .IE.  SEQIO-*-SEQIIC)  WRITE(KW,335)  RECII.  11(1)  .SEQIO 

264  336  F0RMAT(/10X, 'REC  #’,I6,'  =>  SEQ  #’,I6,'  RECORD  OUT  OF*. 

255  e  '  SEQUEICE  (FORMER  SEQ  »  WAS ',16,')') 

256  SEQIO  =  11(1) 

267  IF(PRSI  .EQ.  1)  PRESS  =  II(PRWDIO) 

268  IF(TPSI  .EQ.  1)  TEMP  =  II(TPWDIO) 

259  IF(AMSI  .EQ.  1)  AMBIS  =  II(AMWDIO) 

260  DO  46  L=LBFST,LBLST 

261  OUT(L)=II(L) 

262  45  COITIIUE 

263  c******* 

264  C*******  IF  REQUESTED,  SCALE  TTA  AID  TTB  TO  DECIMAL  SECOIDS  AID  PRUT 

266  c******* 

266  IF  (DESW  .EQ.  0)  GO  TO  50 

267  DOUT(l)  =  SEQIO 

268  DO  46  I  =  LBFST.LBLST.ITT 


269 

DOUT(I)  =  OUT(I)  /  SFl 

270 

IF(ITT  .GT.  1)  D0UT(I+1)  =  0UT(I+1)  /  SF2 

271 

46 

COITIIUE 

272 

WRITECKVDEC ,410)  RECII , SEQIO , PRESS ,TEMP , AMBIS , 

273 

«  (DOUT(I) ,I=LBFST,LBLST) 

274 

410 

F0RMAT(5I10,/(8F10.6)) 

275 

c******* 

276 

c*******  IF  REQUESTED,  PRUT  THE  IITEGER  DATA 

277 

c******* 

278 

50 

COITIIUE 

279 

IF  (IISW  .EQ.  0)  GO  TO  60 

280 

WRITE (KWIIT , 420 )  RECII , SEQIO , PRESS , TEMP , AMBIS , 

281 

e  (OUT(I) ,I=LBFST,LBLST) 

282 

420 

F0RMAT(5I10,/(8I10)) 

283 

C****4>** 

284 

c*******  DETERMIME  THE  FREQUEICY  DISTRIBUTIOI  OF  THE 

DATA 

285 

C*««4>***  AID  LIMIT  THE  RAIGE 

286 

c******* 

287 

60 

COITIIUE 

288 

BOTA  =  0 

289 

TOPA  =  0 

290 

BOTB  =  0 

291 

TCPB  =  0 

292 

DO  66  I  =  LBFST,LBLST,ITT 

293 

IF  (OUT(I)  .GT.  LBIDA)  GO  TO  62 

294 

OUT(I)  =  LBIDA 

295 

DOUT(I)  =  DLBIDA 

296 

BOTA  =  BOTA  +  1 

297 

62 

IF  (OUT(I)  .LT.  UBIDA)  GO  TO  64 

298 

OUT(I)  =  UBIDA 

299 

DOUT(I)  =  DUBIDA 

300 

TOPA  =  TOPA  +  1 

301 

64 

COITIIUE 

302 

IIDX  =  (OUT(I)  -  LBIDA)  /  lUMPLA  +  1 

303 

FREQA(IIDX)  =  FREQA(IIDX)  +  1 

304 

66 

COITIIUE 

305 

c******* 

306 

C*******  IF  MORE  THAI  OIE  DETECTOR  WAS  USED,  CALCULATE 

THE  FREQUEICY 

307 

DISTRIBUTIOI  OF  THE  SECOID  MEASUREMEITS .  IICREMEIT  COUITERS 

308 

c******* 

309 

IFCITT  .EQ.  1)  GO  TO  76 

310 

LBl  =  LBFST  +  1 

311 

DO  74  I  =  LB1,LBLST,ITT 

312 

IF  (OUT(I)  .GT.  LBIDB)  GO  TO  70 

313 

OUT(I)  =  LBIDB 

314 

DOUT(I)  =  DLBIDB 

315 

BOTB  =  BOTB  +  1 

316 

70 

IF  (OUT(I)  .LT.  UBIDB)  GO  TO  72 

317 

OUT(I)  =  UBIDB 

318 

DOUT(I)  =  DUBIDB 

319 

TOPB  =  TOPB  +  1 

320 

72 

COITIIUE 

321 

IIDX  =  (OUT(I)  -  LBIDB)  /  lUMPLB  +  1 

322 

FREQB(IIDX)  =  FREQB(IIDX)  +  1 

64 


323  74  COITIIUE 

324  LCTB  =  LCTB  +  BOTB 

325  UCTB  =  UCTB  +  TOPB 

326  c******* 

327  C*******  IICREMEBT  THE  COUITERS 

328  c******* 

329  76  RECOUT  =  RECOUT  +  1 

330  LCTA  =  LCTA  +  BOTA 

331  UCTA  =  UCTA  +  TOP A 

332  C******* 

333  C^******  GEIERATE  A  LEVEL-1  (SIIGLE  RECORD)  GRAPH  IF  REQUESTED 

334  C******* 

336  78  IF  (GRLl  -EQ.  0)  GO  TO  35 

336  FROM  =  RLOIl 

337  TO  =  0 

338  CALL  FREQGRC LEVEL 1. FROM. TO) 

339  GO  TO  36 

340  c******* 

341  C*******  WRAP  UP  -  WRITE  OUT  MESSAGES  'rO  USER 

342  C******* 

343  1000  COITIHUE 

344  WRITE(KW,340) 

346  340  F0RMAT(/10X, 'PROCESS IMG  EHDED  AT  EID  OF  DATA') 

346  1100  COHTIIUE 

347  WRITE(KW,346)  RECII  .RECOU": 

348  345  F0RMAT(///T10, 18. '  LOGICAL  RECORDS  READ' , 

349  6//T10.I8.’  LOGICAL  RECORDS  PROCESSED') 

350  C******* 

361  C*******  TO  EID: 

362  C*******  PRUT  AID  GRAPH  THE  FREQUEICY  DISTRIBUTIOI 

363  C*******  GEIERATE  A  LEVEL-3  (TOTAL)  GRAPH 

354  c******* 

366  CALL  FREQGR  (LEVEL3. START. RECII) 

366  WRITE(*.43) 

367  43  FORMATClX.//. '  WE  ARE  lOW  DOIE!  -  GOOD  LUCK!'./) 

368  STOP 

369  EID 

360  c******* 

361  c******** ********************************************************* ****** 

362  c******* 

363  C*******  SUBROUTIIES 

364  C******* 

366  c********************* **************************************** ********** 

366  C******* 

367  SUBROUTIIE  RDBUIS(IWORDS.II) 

368  COMMOI/UIIT/KR,  KW,  KWDEC,  KWIIT.  KRBUIS.  RDFMT 

369  IITEGER*4  11(100) .RDFMT 

370  C******* 

371  C*******  READ  EITHER  BIIARY  OR  FORMATTED  DATA 

372  c******* 

373  IF(RDFMT  .EQ.  1)  GO  TO  90 

374  READ (KRBUIS . EID=99 )(II(I).I=1. IWORDS) 

376  RETURI 

376  90  READ(KRBUIS.96.EID=99)  (II(I) . 1=1 .IWORDS) 
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377 

378 

379 

380 

381 

382 

383 

384 

385 

386 

387 

388 

389 

390 

391 

392 

393 

394 

395 

396 

397 

398 

399 

400 

401 

402 

403 

404 

405 

406 

407 

408 

409 

410 

411 

412 

413 

414 

415 

416 

417 

418 

419 

420 

421 

422 

423 

424 

425 

426 

427 

428 

429 

430 


95  F0!mAT(8I10) 

RETURl 
99  II(1)=-1 
100  COITIIUE 
RETURl 
EID 

c******* 

SUBROUTIIE  FREQGRCLEVEL.FROM.TO) 

COMMOI  FREQ . LCT . UCT . LBID . UBID . lUMLI . lUMPL , SF , RATE . GRPS IZ 
COMMOI/IUMBR/ITT , LBFST . LBLST , TTYPE 
COMMOI/UIIT/KR,  KW,  KWDEC,  KWIIT,  KRBUIS,  RDFMT 
IITEGER*4  FREQ(55,6).LCT(6),UCT(6) 

IITEGER*4  LBID(2) ,UBID(2) .IUMLI(2) .IUMPL(2) 

REAL*4  SF(2) 

IITEGER*4  RATE,GRPS1Z.TTYPE(2) 

IITEGER*4  LEVEL, FROM, TO 
IITEGER*2  LIIE(llO) 

DATA  LIIE/110*'X'/ 

C******* 

c*******  GRAPH  BOTH  THE  A  AID  B  TRAVEL  TIMES 

DO  50  K  =  1,ITT 
L  =  LEVEL  -  1  +  K 

C*«****« 

C******* 

c**«***«  PRUT  THE  GRAPH  HEADIIG 

C*«****« 

WRITE(KW,101)  TTYPE(K),FROM 

101  F0RMAT(1H1/T60,A4, ’  FREQUEICY  DISTRIBUTIOI' ,T100, 'REC  #' ,16) 
IF  (TO  .IE.  0)  WRITE(KW,102)  TO 

102  F0RMAT(1H+,T112, ’THRU’ ,16) 

IF  (RATE  .IE.  0)  WRITE(KW,103)  RATE,GRPSIZ 

103  FORMATCT 100, ’RATE  ’ ,I6,T112, ’GROUP’ ,15) 

C**««*«*  DETERMIIE  THE  MAXIMUM  VALUE  TO  BE  GRAPHED 
MAX  =  0 

DO  10  I  =  1,  55 

10  IF  (FREQd.L)  .GT.  MAX)  MAX  =  FREq(I,L) 

c«*«****  PRUT  THE  GRAPH 
C******* 

IL  =  lUMLI(K) 

DO  20  I  =  1,  IL 

lOX  =  FREQ(I.L)  •  100  /  MAX  +  1 
IVAL  *  LBID(K)  +  (I-l)  ♦  lUMPL(K) 

DVAL  =  IVAL  /  SF(K) 

WRITE  (KW,106)  IVAL, DVAL, FREq(I,L),(LIIE(IX),IX=l,IOX) 

105  FORMAT(I10,F10.5,I8,2X,102A1) 

20  COITIIUE 

WRITE  (KW,110)  LBID(K),LCT(L),UBID(K),UCT(L) 

110  FORMAT  (//T20,’#  UIDER  ’,18,’  =  ’.16, 
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431  e//T20, '#  OVER  ',18,*  =  *.16) 

432  C******* 

433  C*******  ADD  THE  TOTALS  FOR  THIS  LEVEL  TO  THE  TOTALS  FOR  THE  MEAT  LEVEL 

434  C*******  AMD  ZERO  THE  TOTALS  FOR  THIS  LEVEL 

435  C******* 

436  IF  (L  .GT.  4)  GO  TO  40 

437  J  =  L  +  2 

438  DO  30  I  =  1,  55 

439  FREQ(I.J)  =  FREQ(I,J)  +  FREQ(I,L) 

440  30  FREQd.L)  =  0 

441  UCT(J)  =  UCT(J)  +  UCT(L) 

442  LCT(J)  =  LCT(J)  +  LCT(L) 

443  UCT(L)  =  0 

444  LCT(L)  =  0 

445  40  COITIMUE 

446  50  COITIMUE 

447  RETURM 

448  EMD 


3.3  FILL_JAN91.FOR 


3  c*/X/.*/.y.  lill_jan91.1or 

4 

5  c#####  Revision  of  FILL. AUG90 . FOR  by  K.  Tracey  January  1991 

6  c#####  Reworked  the  code  for  handling  bad/missing  records: 

7  c#####  When  good  records  are  interspersed  between  bad  and  missing  records, 

8  c#####  earlier  versions  of  the  code  did  not  keep  these  yearhours  in  their 

9  c#####  correct  order.  In  the  earlier  codes,  all  missing  records  were  added 

10  c#####  at  once;  thus  causing  a  good  yearhour  to  be  put  out  of  sequence. 

11  c##*##  low  the  code  has  been  modified  to  add  the  missing  records  before  and 

12  c#####  after  the  good  yearhours,  keeping  them  in  their  correct  order. 

13  cv/:m 

14  revision  of  fill_jul88.for 

15  c'/.yyy.y.  This  version  will  make  three  output  files;  travel  time,  temperature, 

16  c'/.'/,'/,'/.*/.  emd  pressure.  Each  will  be  assigned  the  proper  time  according  to 

17  c */,'/,'/,*/,%  the  particular  model  PIES,  URI  or  Sea  Data.  The  motivation  for 

18  c'/.'/,'/,'/.%  separating  the  records  arose  when  it  was  found  that  the  different 

19  c*XVX/>/«  model  PIES’  didn’t  sample  identically.  The  sampling  relative  to  the 

20  c‘/,‘/,'/X/>  travel  time  is: 

21  c'/,*/,'/.y,%  URI-  temp  -115  sec  SD-  temp  773.750  sec 

22  c'/X/X/^  press  -115  sec  press  1645.625  sec 

23  cy.y.y.y.y. 

24  here  the  time  represents  the  period  AFTER  the  center  of  the  travel 

25  c'/X/X/i  time  measurement  (center  of  the  burst  of  24  pings)  when,  for  a  given 

26  c'/XV/'/,  scan  the,  particular  sensor  is  sampled. 

27  cyx/.y,y. 

28  c'/X/X/.  A  namelist  was  added  to  the  control  file  which  specifies  if  the 

29  c'/X/XX  instrument  is  a  pressure  instrument,  and  if  so  what  model.  ”card3" 

30  c'/X/X/.  has  variables  "pies"  and  "model".  The  first  character  of  "pies"  is 

31  checked  for  a  "Y"  or  "y".  The  first  character  of  model  is  checked 

32  c'/.'/X/A  for  a  "S"  or  "s"  to  designate  a  SD  from  a  URI  model  echo  sounder. 

33  cVIUmi,  The  relative  sample  times  above  are  correspondingly  added  to  the 

34  c'/X/X/^  yearhour  column  of  the  inputed  memod  file  and  outputed  to  files 

35  c'lXmiX  e.tmp,  e.prs,  and  e.fill. 

36  cyx/x/. 

37  C'/'/'/'/X  additional  i/o  units: 

38  CV/XX,%  kw2  (UIIT  15)  -  pressure  output  file 

39  CV/XXX,  kw3  (UIIT  16)  -  temperature  output  file 

40  mm, 

41  mmX  Changes  will  be  mostly  lower  case,  but  some  capiTalization. 

42  z'mXX  more  later.  Fields  4-Aug-90 

43 

44 

45  ceeeeeee 

46  c*******  FILL. JULY88. For 

47  c******* 

48  ceeeeeee  ORIGIIALLY  WRITTEI  BY  J.  GUII  JAIUARY  1980 
48  ceeeeeee  REVISED  BY  K.  TRACEY  SIICE  1981 

60  c*******  COIVERTED  FOR  VAX  S.  WOOD  1988 

5i  c******* 

62  C*******  THE  PURPOSE  OF  THIS  PROGRAM  IS  TO  SEARCH  THROUGH  THE  lES 
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63 

54 

55 

56 
67 

58 

59 

60 
61 
62 

63 

64 
66 
66 

67 

68 

69 

70 

71 

72 

73 

74 
76 

76 

77 

78 

79 

80 
81 
82 

83 

84 

85 

86 

87 

88 

89 

90 

91 

92 

93 

94 

95 

96 

97 

98 

99 
100 
101 
102 

103 

104 

105 

106 


C*******  RECORD  TO  MAKE  SURE  THAT  THE  TIMES  ARE  IICREMEITIIG  CORRECTLY. 
C***4>**«  THERE  ARE  TWO  TYPES  OF  ERRORS  II  THE  TIME  BASE;  1)  THE  DATA 
C««***«*  PECORD  FROM  A  SAMPLIIG  TERTOD  IS  MTSSIIG,  AID  2)  THE  RECORD  IS 
c*******  there  BUT  THE  TIME  ASSOCIATED  WITH  IT  IS  IICORRECT.  IF  A 
C*******  RECORD  IS  MISSIIG,  A  HEW  DIE  IS  IISERTED  WITH  IMTERPOLATED 
C«****««  VALUES. 


C******:»  the  USER  CAI  EITHER  PROCESS  THE  TOTAL  DATASET  OR  SEARCH 

C*******  THROUGH  A  SMALLER  PORTIOI  BY  SPECIFIYIIG  ISTRAT  AMD  ISTOP  TO 
C*******  SELECT  THE  RECORDS.  IF  A  DATA  GAP  GREATER  THAI  MAXDLT  IS 
C****«**  EICOUITERED,  THE  PROGRAM  HALTS. 


cr//////////m//////////.r/.y.y.*/.ny. 


cy.y,y,y.y.  logical  unit  nuabars  hav«  b«an  changed  to  avoid  using 
c'/.V,V,y,V,  Tin  it  8  5  and  6. 


cyx/x/x///.yx/x/x/xmy.y.y. 


c*******  I/O  UlITS: 

Ceeeeeee  KR  (UIIT  17)  -  COMTROL  PARAMETERS 

Ceeee***  KW  (UIIT  18)  -  USERS  OUTPUT  LOG 

c*******  KRI  (UIIT  19)  -  IIPUT  DATASET  FROM  MEMOD 

C*******  KWl  (UIIT  20)  -  OUTPUT  DATA  FILE 

C******* 


c********************************************************************* 

c******* 

CHARACTER*60  HEADR 
character*3  model, press 
logical  pies 

IITEGER*4  RECII.recadd,  RECOUT,  RDOFF,  MAXBAD 
IITEGERV4  I ALL, I ADD, IB AD. KR,KW, KWl 
IITEGER*4  FLAG,IFLAG,LSTREC,LOKREC 
IITEGERM  LIKECT,LIIPPG,LIMADD 
integer*4  index(300),  need(300) 

REAL*4  MAXDLT,  DELTAT 

REALM  TT.PR,TP.AM,YRHR 

REAL*4  LOKTT , LOKPR . LOKTP , LOK AM , LOKYHR 

REAL*4  LSTTT,LSTPR,LSTTP,LSTAM,LSTYHR 

REAL*4  TTADD , PRADD .TP ADD , AMADD , YHRADD 

REALM  DLTTT,DLTPR,DLTTP,DLTAM.DIFYHR 

REAL*4  SAVTT(300) .SAVPR(300) .SAVTP(300) ,SAVAM(300) 

reale4  SAVYHR(300) 

REAL*4  OKDLT,  lESDLT 

real*4  goodyr(0:300) ,goodtt(0;300),  goodpr(0: 300) ,  goodtp(0 : 300) 
real*4  midokyr 

PARAMETER  (KR=17 ,KW=18 ,KR1=19 ,KW1=20 ,kw2=16 ,kw3=16) 

PARAMETER  (LIIPPG=64) 
lAMELIST/CARDl/  HEADR 

IAMELIST/CARD2/  ISTART . ISTOP .MAXDLT , DELTAT 
namelist/cardS/  press, model 

DATA  IADD/0/.IBAD/0/,IALL/0/ 

DATA  RECII/0/,REC0UT/0/,RECADD/0/ 

DATA  MAXB AD/300/ , LIIECT/66/ , LIIADD/0/ 

DATA  FLAGZ-l/.pies/O/ 

C*****  Open  I/O  units  and  files 
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107  OPEI(UIIT=KR,STATUS='OLD' ,  FORM= ’ FORMATTED ' .  READOMLY) 

108  OPEI(UIIT=KW.STATUS='IEW' . FORM= ' FORMATTED ' ) 

109  0PEI(UIIT=KR1.STATUS=' OLD *,FORM=' FORMATTED',  READOMLY) 

1 1 0  OPEI  (UIIT=IC1/1 .  STATUS= '  MEW ' .  FORM= ' FORMATTED ' ) 

111  C***** 

112 

113  C*****  READ  THE  COITROL  PARAMETERS  AID  WRITE  TO  LOG 

114 

115  READ(KR.MML=CARD1) 

116  READ(KR,1NL=CARD2) 

117  READ(KR,IML=CARD3) 

118  if  ((pressd  :  1)  .«q. 'y')  .or .  (preaad  :  1)  .«q.’Y’))  then 

119  pie8=.true. 

120  open(unit=kw2,8tatus='ne«’ , forB=’ formatted ’ ) 

121  open(unit=kH3,8tatu8=*nes’ ,form=’formatted‘) 

122 

123  if  ( (modeld : 1) . eq. 'a ’) .or . (modelCl : 1) . eq. 'S’ ))  then 

124  tmp_tcf=  1645.646/3600. 

125  pr8_tcf=  773.750/3600. 

126  elae 

127  tmp_tcf=-116./3600. 

128  pr8_tcf=-115./3600. 

129  endif 

130  endif 

131  WRITE(KW.410)  HEADR 

132  410  F0RMAT(//A60) 

133  WRITE(KW,416)  ISTART,MSTOP,MAXDLT,DELTAT 

134  415  FORMAT ( //SX, 'ISTART  =' ,I5,9X, 'ISTOP  =' ,I5,9X, ’MAXDLT(HRS)=’ , 

135  «F10.4,5X,'DELTAT  =',F10.4) 

136  C******* 

137  C*****ee  RESET  PARAMETERS 

138  C******* 

139  IGAP  =  MAXDLT/DELTAT  +0.5 

140  IF  (IGAP  .LE.  300)  GO  TO  5 

141  WRITE(KW,416) 

142  416  FORMATd  MAXDLT  TOO  BIG  FOR  ARRAYS  *******♦♦*'/ 

143  C  ’  RESET  MAXDLT  OR  CHAIGE  DIMEISIOIS'/ 

144  «  ’  RUI  TERMIIATED') 

146  STOP  416 

146  5  COITIIUE 

147  IF  (MAXBAD  .IE.  IGAP)  MAXBAD  =  IGAP 

148  c******* 

149  C*******  SKIP  OVER  IIITIAL  RECORDS  IF  DESIRED. 

150  C*******  IICREMEIT  IIPUT  AID  OUTPUT  COUITERS. 

161  C******* 

152  I-ISTART 

163  10  IF(I  .LE.  1)  GO  TO  20 

164  READ(KR1,420,EID=80)  TT.PR.TP.AM.YRHR 

155  420  F0RMAT(5E15.7) 

156  RECII=RECII  +  1 

167  WRITE(KW1,420)  TT.YRHR 

158  if  (piea)  then 

159  vrite(k«2,420)  pr ,yrhr+pr8_tcf 

160  vrite(k«3,420)  tp,yrhr+tmp_tcf 
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161  endif 

162 

163  RECOUT  =  RECOUT+1 

164  1=1-1 

165  GO  TO  10 

166  C******* 

167  C*****’**  BEGII  PROCESSIIG  BY  READIIG  lEXT  DATA  RECORD. 

168  C*******  ASSUME  ITS  YEARHOUR  IS  CORRECT. 

169  c******* 

170  20  COITIIUE 

171  READ(KR1.420,EID=80)  TT.PR.TP.AM.YRHR 

172  RECII=RECII+1 

173  WRITE(KW,42S)  RECII.YRHR 

174  426  FORMAT (//5X, ’FIRST  RECORD  OF  THE  SERIES  IS  IIPUT  REC#  =  ’.15. 

175  e5X.’YRHR=  ’.F12.5////) 

176  C******* 

177  c*******  MAIM  PROCESSIIG  LOOP 

178  C*******  WRITE  RECORD  IF  TIME  IS  GOOD 

179  C*******  SAVE  VALUES  AS  ’LAST  OKAY’ 

180  C***'**** 

181  26  WRITE(KW1.420)  TT.YRHR 

182  if  (piss)  then 

183  Brit«(kB2,420)  pr .yrhr+prs_tcf 

184  write(kB3.420)  tp.yrhr+tmp_tcf 

185  «ndif 

186 

187  REC0UT=REC0UT+1 

188  LOKYHR=YRHR 

189  LOKTT=TT 

190  LOKPR=PR 

191  LOKTP=TP 

192  LOKAM=AM 

193  C******* 

194  C*******  SAVE  THE  MOST  RECEHTLY  READ  DATA  VALUES 

196  C*******  CHECK  FOR  EID  OF  PROCESSIIG 

196  c******* 

197  30  COITIIUE 

198  IFCIBAD  .GE.  MAXBAD)  GO  TO  90 

199  IF(RECII  .GE.  ISTOP)  GO  TO  70 

200  LSTYHR=YRHR 

201  LSTTT=TT 

202  LSTPR=PR 

203  LSrrP=TP 

204  LSTAM=AM 

206  C******* 

206  C*******  READ  lEXT  DATA  RECORD.  CHECK  FOR  PROPER  SEQUEICIIG 

207  C******* 

208  READ (KRl, 420, EID=80)  TT.PR.TP.AM.YRHR 

209  RECII=RECIH-M 

210  IESDLT=YRHR-LSTYHR 

211  c^****** 

212  C****«*«  A)  THE  SEQUEICIIG  IS  WROIG.  SAVE  THIS  OIE  AS  BAD 

213  C*******  AID  THEI  GO  GET  THE  lEXT  RECORD 

214  C*^'***** 
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215  IF(ABS(IESDLT  -  DELTA!)  .GT.  0.1)  GO  TO  35 

216  C******* 

217  C*******  B)  THIS  OIE  IS  OKAY.  BUT  THE  PREVIOUS  RECORDS  WERE  BAD 

218  C*******  SO  WORK  01  CLEAIIIG  UP  THE  DATASET 

219  C****«** 

220  IFdBAD  .IE.  0)  GO  TO  40 

221  C******* 

222  C*******  C)  THIS  DIE  IS  OKAY,  PREVIOUS  WERE  OKAY.  SO  GET  lEXT  RECORD 

223  C******* 

224  GO  TO  25 

225  C**4"**** 

226  C*******  RECORD  IS  OUT  OF  SEQUEICE  -  SAVE  IT 

227  c******* 

228  35  COITIIUE 

229  IBAD  =  IBAD-t-1 

230  SAVYHR(IBAD)=YRHR 

231  SAVTT(IBAD)=TT 

232  SAVPR(IBAD)=PR 

233  SAVTP(IBAD)=TP 

234  SAVAM(IBAD)=AN 

235  GO  TO  30 

236  c******* 

237  C*******  PROPER  SEQUEHCIIG  HAS  RESUMED.  BUT  PREVIOUS  RECORDS 

238  C*******  WERE  OUT  OF  ORDER. 

239  C******* 

240  40  COITIIUE 

241  DLTYHR=LSTYHR-LOKYHR 

242  OKDLT=DLTYHR-IBAD*DELTAT 

243  IFCOKDLT  .GT.  MAXDLT)  GO  TO  90 

244  IADD=IADD+RDOFF(OKDLT/DELTAT) 

245  IBAD=IBAD-1 

246  lALL^IBAD-flADD 

247  C******* 

248  C*******  WRITE  TO  LOG  -  OUT  OF  SEQUEICE  RECORDS 

249  C******* 

250  IFCLIIECT  .LT.LIIPPG)  GO  TO  50 

251  WRITE(KW,430) 

252  430  FORMAT('l’) 

253  WRITE (KW, 432) 

254  432  FORMAT (//7X, 'LAST  GOOD  SEQUEICIIG' .8X, ’SEQOEICIIG  RESUMED’, 

255  MX .  ’  #  ADDED  ’ ,  5X ,  ’  RECORDS  WITH  YRHRS  ’  / 

256  69X, ’RECII’ .4X, 'LSTOK  YRHR’ ,8X, ’RECII’ ,5X, 'LST  YRHR' , 

257  MX ,  ’  RECORDS  ’ ,  6X ,  ’  OUT  OF  SEQUEICE  ’ ) 

258  WRITE(KW,434) 

259  434  F0RMAT(’  +  ’,2(5X,’ _  ’),2(5X.’ _ ’). 

260  •’ _ ’//) 

261  LIIF.CT=0 

262  50  COITIIUE 

263  L0KREC=RECII-IBAD~2 

264  LSTREC=RECII-1 

265  IFCIBAD  .EQ.O)  GO  TO  52 

266  WRITE(KW.435)  LOKREC.LOKYHR.LSTREC.LSTYHR.IADD, (SAVYHR(I) . 

267  ei=l,IBAD) 

268  435  F0RMAT(1X,2(6X.I10,2X,F10.2) ,6X,I7,6X.5F10.2.10(/72X.5F10.2)) 
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269 

270 
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314 

315 
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317 
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319 

320 

321 

322 


IF(M0D(IBAD.5)  .IE.  0)  LIMADD=1 
LIIADD=LIIADD^1 
LIIECT=LIIECT+LIIADD 
LIIADD=0 
GO  TO  55 
52  COITIIUE 

WRITE(KW , 435)  LOKREC , LOKYHR . LSTREC . LSTYHR , I ADD 
LIIECT=LIIECT+1 

C*******  IF  NISSIIG  RECORDS,  d«termin«  if  any  of  the  "bad"  records  may 
c  ******  in  fact  be  good.  Ve  will  want  to  use  them  if  possible,  and  add 
c*******  missing  records  before  and.^or  after  them  as  necessaury 

C******* 

55  IF  (lADD  .gt.  0)  than 
nparts  =  1 
index(l)  =  nbad 
midokyr  =  lokyhr 
midindex  =  0 
nleft  =  nadd 
goodyr(O)  =  lokyhr 
goodtt(O)  =  loktt 
goodpr(O)  =  lokpr 
goodtp(O)  =  loktp 

do  56  k  =  1 , nbad 

if  (savyhr(k)  .gt.  lokyhr  .and.  8avyhr(k)  .It.  Istyhr)  then 

c*****  This  may  be  a  "good"  yearhour.  First  make  sure  that  it  has  proper 
c*****  incrementation. 

irem  =  int(  (aavyhr(k)  -  lokyhr)  /  deltat) 
have  =  lokyhr  +  irem*deltat 

c*****  Yes  this  is  a  good  yearhour,  determine  how  many  records  must  be  added 
c*****  before  this  one. 

if  (  absChave  -  8avyhr(k))  .It.  0.05  )  then 
diff  =  savyhr(k)  -  midokyr 
nwant  =  rdoff (diff /deltat) 
nhave  =  k  -  midindex 
nowneed  =  nwant  -  nhave 
if  (nowneed  .le.  nleft)  then 
if  (nowneed  .It.  0)  then 

if  (nowneed  >  need(npart8-l)  .eq.  0)  then 
nleft  =  nleft  +  need(npart8-l) 
nparts  =  nparts  -  1 
nowneed  =  0 

else 

go  to  56 
end  if 
end  if 

need(npart8)  =  nowneed 
nleft  =  nleft  -  naed(npart8) 
indax(nparts)  =  k 
goodyr( nparts)  =  savyhr(k) 
goodtt(npart8)  =  8avtt(k) 
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354 

355 

356 
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goodpr(npart8)  =  savpr(k) 
goodtpCnparts)  =  savtpCk) 
midokyr  =  savyhr(k) 
midindex  =  k 
nparts  =  npa^rts  1 
end  if 
end  if 
end  if 

56  continue 

needCnparts)  =  nleft 
goodyr (nparts)  =  Istyhr 
goodtt (nparts)  =  Isttt 
goodpr (nparts)  =  Istpr 
goodtp (nparts)  =  Isttp 
end  if 
C******* 

C*******  IITERPOLATE  IF  lECESSARY  AID  WRITE  OUT  ALL  'SAVED'  RECORDS 
C******* 

60  COITIIUE 

C****4> 

c*****  Case  1:  lo  records  missing,  but  some  yearhours  vere  bad. 

c*****  Fix  Up:  Adjust  the  yearhours  to  be  correct;  don't  add  any  records. 

if  (nadd  .eq.  0)  then 
do  61  ii  s  1,  nbad 

yhradd  =  ii*deltat  +  lokyhr 
urite(kHl ,420)  savtt(ii) , yhradd 
if  (pies)  then 

Brite(kH2,420)  savpr(ii) ,yhradd+pr8_tcf 
«rite(kH3,420)  savtp(ii) ,yhradd+tmp_tcf 

endif 

recout  =  recout  +  1 
nflag  =  nflag  *  1 

61  continue 


else 

c*****  Case  2:  Records  must  be  added  during  one  or  more  sub-zones, 
c*****  delineated  by  "good"  yearhours. 

c*****  Fix  up:  Added  records  before  the  "good"  records  if  needed. 
c*****  Interpolating  travel  time,  pressure,  and  temperature. 

yhradd  =  lokyhr 
do  69  k  =  1 ,  nparts 
if  (k  .eq.  1)  then 
Ifst  =  1 

else 

Ifst  =  index(k-l)  +  1 
end  if 

if  (k  .eq.  nparts)  then 
last  =  nbad 

else 

last  =  index(k)  -  1 
end  if 
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c*****  Add  ■issing  records  first. 

if  (need(k)  .ne.  0)  then 

DLTyr=  goodyr(k)  -  goodyr(k-l) 

DLTTT=  goodtt(k)  -  goodtt(k-l) 

DLTPR=  goodpr(k)  -  goodpr(k-l) 

DLTTP=  goodtp(k)  -  goodtp(k-l) 
do  63  kadd  =  1,  need(k) 
yhradd  =  deltat  +  yhradd 
dif yhr=kadd*deltat/dltyr 
ttadd=dif yhr*dlttt+loktt 
pradd=difyhr*dltpr+lokpr 
tpadd=difyhr*dlttp+loktp 
write(kBl ,420)  ttadd, yhradd 
if  (pies)  then 

Brite(kH2,420)  pradd,yhradd+prs_tcf 
Brite (kH3 , 420)  tpadd , yhradd+tmp_tcf 
endif 

nf lag=nf lag+1 

recadd=recadd+l 

nadd=nadd-l 

63  continue 

end  if 

c  ••***  lext  right  out  any  records  Bith  bad  yearhours. 

do  65  1  =  If St,  last 

yhradd  =  deltat  +  yhradd 
BriteCkBl  ,420)  savttd)  , yhradd 
if  (pies)  then 

Brite(kB2 ,420)  savpr(l) ,yhradd+prs_tcf 
Brite(kB3,420)  savtpd)  ,yhradd+tiap_tcf 
endif 

nflag=nf lag+1 
recout=recout+l 
65  continue 

c  *****  Finally  Brite  out  the  "good"  record  if  it  lies  betBeen  bad  ones, 
if  (k  .It.  nparts)  then 

Brite(kBl ,420)  savtt(index(k)) , savyhr( index (k) ) 
if  (pies)  then 

Brit e(kB2, 420)  savpr ( index (k)) ,savyhr( index (k) )+prs_tcf 
Brita(kB3,420)  savtp( index (k)) ,8avyhr( index (k))+tap_tcf 
endif 

recont  =  recout  +  1 
yhradd  =  8avyhr(index(k)) 
end  if 

69  continue 

end  if 

c  *****  All  finished  Bith  these  records. 


IADD=0 


431  IBAD=0 

432  WRITE (KW 1.420)  LSTTT.LSTYHR 

433  if  (pies)  then 

434  write(ltw2,420)  Istpr.lstyhr+prs.tcl 

435  Brite(kw3,420)  Isttp.lstyhr+tmp.tcl 

436  endif 

437 

438  REC0UT=REC0UT+1 

439  IF(REC0UT  .GE.  ISTOP)  GO  TO  70 

440  GO  TO  25 

441  Ceeeeeee 

442  C*******  EID  OF  PROCESSIIG  -  WRAP  UP 

443  Ceeeeee*  READ  AID  WRITE  AIY  RENAIIIIG  RECORDS 

444  Qt****** 

445  70  COITIIUE 

446  READ(KR1.420.EID=85)  TT.PR.TP, AM.YRHR 

447  RECI1=RECI1+1 

448  WRITE (KW 1,420)  TT.YRHR 

449  if  (pies)  then 

450  write(kH2,420)  pr ,yrhr+pr8_tcf 

451  write (k83 ,420)  tp,yrhr+tinp_tcf 

452  endif 

453 

454  REC0UT=REC0UT+1 

455  GO  TO  70 

456  c******* 

457  C*******  UIEXPECTED  EID  OF  IIPUT  DATA 

458  C******* 

459  80  COITIIUE 

460  IFdBAD  .IE.  0)  GO  TO  40 

461  WRITE (KW, 440) 

462  440  F0RI1AT(//6X. ’UIEXPECTED  EID  OF  FILE  EICOUITERED  BEFORE  ISTOP’ 

463  C’  RECORDS  WERE  READ’) 

464  C******* 

465  C*******  lORMAL  EID  OF  PROCESSIIG  -  WRITE  TO  USERS  LOG 

466  C******* 

467  85  COITIIUE 

468  WRITE(KW.442)RECII,YRHR 

469  442  FORMAT ( ///5X, ’LST  RECORD  OF  THE  SERIES  IS  IIPUT  REC#  =  ’. 

470  CI5.5X. ’YRHR  =  ’,F12.S) 

471  86  COITIIUE 

472  RECOUT=RECOUT+RECADD 

473  WRITE(KW,444)  RECII.RECADD.RECOUT.IFLAG 

474  444  FORMAT (//6X, ’TOTAL  RECORDS  READ  =  ’,T36,I10, 

475  e/6X, ’TOTAL  RECORDS  ADDED  =  ’,T36,I10. 

476  e/5X. ’TOTAL  RECORDS  OUTPUT  =’,T35,I10, 

477  •/SX. ’TOTAL  FLAGGED  YRHRS  =’,T36,I10) 

478 

479  STOP 

480  C******* 

481  Ceeeeeee  TOO  NAIY  OUT  OF  SEQUEICE  RECORDS  II-A-ROW,  TERMIIATE  RUI 

482  c«***e** 

483  90  COITIIUE 

484  WRITE(KW,446)  NAXBAD.RECII 
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485  446  FORMAT (//SX. ’MORE  THAI  ‘,14.’  COMSECUTIVE  OUT-OF-SEQUEICE’ . 

486  6’  RECORDS  EICOUITERED ’ , 

487  •//6X,’LAST  IIPUT  RECORD  READ  WAS  RECII  =  ’,15, 

488  C//5I , ’ RUI  TERMIIATED ’ ) 

489  STOP  999 

490  EID 

491  C******* 

492  C***************************************^** *************** *«***<  *«*««****« 

493  C******* 

494  IITEGER  FUICTIOI  RDOFF(REAL) 

495  IUMBER=IF1X(REAL) 

496  REST=REAL-IUMBER 

497  IF(REST  .LT.  0.5)  GO  TO  110 

498  IUMBER=IUMBER't-l 

499  110  ROOFF=IUMBER 

500  RETURI 

501  EID 


3.4  MEMOD_JUL89.FOR 


1  c******* 

2  c******* 

3  c******* 

4  c***!**** 

5  c******* 

6  c******* 

7  c******* 

8  c******* 

9  ct****** 

10  c******* 

11  c******* 

12  C******* 

13  c******* 

14  C******* 

15  C******* 

16  C******* 

17  C******* 

18  C******* 

19  c******* 

20  C******* 

21  c******* 

22  C******* 

23  C******* 

24  c******* 

25  c******* 

26  c******* 

27  c******* 

28  c******* 

29  C******* 

30  c******* 

31  c******* 

32  C******* 

33  c******* 

34  0**^*^** 

36  c******* 

36  c******* 

37  c******* 

38  C******* 

39  c******* 

40  c******* 

41  c******* 

42  c******^ 

43  c******* 

44  c*****«* 

46  C******* 

46  c******* 

47  c******* 

48  c******* 

49  0******* 

60  C******* 

61  c******* 

62  c******* 


MEM0D_Jul89.For 

this  version  vas  modified  19-jul-1989  the  modifcations  aure 
documented  aoid  axe  made  in  lover  case.  The  major  modifications 
aire  the  addition  of  ainother  window  called  binwindov.  This  is 
described  in  the  comment  statements  in  the  routine  of  that  name. 
Another  change  related  to  the  97*/,  confidence  window  applied  within 
ttmode. 


THIS  PROGRAM  IS  DESIGIED  TO  TAKE  GROUPS  OF  lES  TRAVEL  TIMES 
(TTA  AID/OR  TTB)  AID  COMPUTE  THE  MEDIAI  OR  MODAL  VALUE 

ORIGIIALLY  WRITTEl  1979  BY  J.  GUII,  BUT  HAS  BEE!  REVISED  AID 
REWRITTEI  SEVERAL  TIMES  SIICE  THEM. 

THIS  PROGRAM  AT  THE  PRESEIT  TIME  DOES  THE  FOLLOWIIG: 

1)  TTl  AID  TT2: 

THE  PROGRAM  IS  lOW  SET  UP  TO  ALLOW  PROCESSIIG  OF  BOTH  TTl  AID 
TT2  DURIIG  THE  SAME  RUI.  QRIGIAILLY  TT2  COULD  OILY  BE 
PROCESSED  BY  THE  MEDIAI  METHOD.  lOW  THE  USER  CAI  SPECIFY 
EITHER  METHOD  II  THE  COITROL  FILE.  IF  S/R  TTMEDI  IS  USED  THE 
CALCULATIOIS  ARE  DOIE  AS  IITEGERS  THEI  PASSED  BACK  TO  THE 
CALLIIG  PROGRAM  AS  REALS.  IF  OVERRAIGIIG  HAS  TAKEI  PLACE, 
WRAPPIIG  WILL  BE  DOIE  AUTOMATICALLY  AS  LOIG  AS  THE  UBID  IS 
SPECIFIED  SMALLER  THAI  THE  LBID.  THE  OUTPUT  IS  A  SIIGLE 
TT  FOR  A  GIVEI  SAMPLIIG  PERIOD  -  SCLAED  TO  SECOIDS. 

2)  PRESSURE  AID  TEMPERATURE 

ASSUMES  THE  SEISORS  ARE  PAROS  IISTRUMEITS.  THE  USER  SUPPLIES 
THE  COEFFICIEITS  FOR  PRESSURE  AID  CALIBRATIOI  VALUES  FOR 
TEMPERATURE.  TWO  PAROS  EQUATIOIS  CAI  BE  USED  EITHER  THE  A,B 
OR  THE  C.D  EqUATIOI.  THE  TEMPERATURE  DEPEIDEIT  COEF.  ARE 
CALCULATED  USIIG  TEMP  (F)  UILESS  TWO  OF  THE  D  OIES  ARE 
EQUAL.  THEI  TEMP(C)  IS  USED.  OVERRAIGIIG  IS  TAKEI  IITO 
ACCOUIT  IF  THE  USER  SPECIFIES  IT.  01  OUTPUT  PRESSURE  AID 
TEMPERATURE  COUITS  ARE  COIVERTED  TO  DBAR  AID  T(C)  .  IF  lEITHER 
SEISOR  WAS  USED.  THE  OUTPUT  VALUES  ARE  -99. 

3)  TIME  BASE 

TIME  BASE  IS  SET  RELATIVE  TO  ISEQO,  SUPPLIED  BY  THE  USER. 
ASSUMES  THAT  IIPUT  TIME  IS  ALREADY  GMT.  01  OUTPUT.  ALL 
SEQUEICE  lUMBER  ARE  COIVERTED  TO  TIME  II  YEARHOURS.  THESE 
CAI  BE  POSITIVE  OR  lEAGATIVE,  DEPEIDIIG  01  ISEQO. 

IIPUT/OUTPUT  UIITS  USED; 

KR  (UIIT  8)  -  COITROL  IIPUT 

KW  (UIIT  6)  -  LOG  OUTPUT 

KWDA  (UIIT  7)  -  TTl  MODE/MEDIAI  DISK  OUTPUT  DATASET 

KWDB  (UIIT  8)  -  TT2  MODE/MEDIAI  DISK  OUTPUT  DATASET 

KWLA  (UIIT  9)  -  TTl  LISTIIG  OF  STATISTICS 

KWLB  (UIIT  10)  -  TT2  LISTIIG  OF  STATISTICS 

KRBUIS  (UIIT  11)  -  IITEGER  IIPUT  OF  BUIS  DATA 
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63  C******* 

64  CHARACTER*60  READR 

66  CHARACTER*4  I0PT(6) ,  MEDl,  MED2,  MODI,  N0D2,  TTl,  TT2 

56  CHARACTER*3  TTYPE(2) 

67  CHARACTER*2  SEIS0R(3) .  PR,  TP.  AM 

58  CHARACTER*2  EQI,  TYPEqi(2).  QVERIG,  YES 

59  Q^t***** 

60  IITEGER*4  KR,  KW,  KVDA,  KVDB.  KVLA,  KULB 

61  IITEGER*4  ITT 

62  IITEGER*4  IWORDS,  LBURST,  LBFST,  RDFMT 

63  IITEGER«4  ISEI,  SVDI0(3) 

64  IITEGER*4  IFIRST,  IFSEQ,  BLAST,  ILSEQ,  SEQIBC 

65  I1TEGER«4  LBIDl,  UBROl,  LB1D2,  UBBD2 

66  IITEGER*4  LAB,  CTREFl,  CTREF2 

67  IITEGER*4  IX(IOO),  IXB(IOO).  IXX(IOO),  lARRAY(lOO) 

68  IITEGER*4  PWR2.  PMID,  TW0PHR(17) 

69  IITEGER*4  PRWDIO,  TPVDBO.  AMVDIO 

70  IITEGER*4  RECIB,  SEQBO.  ZERO.  FOUR 

71  IITEGER*4  IPASS,  ISEQO,  IPRESS,  ITEMP,  lAMBBS 

72  c******* 

73  IITEGER*2  PRCESl,  PRCES2.  TTISW,  TT2Stf 

74  I1TEGER*2  PRSI ,  TPSI,  AMSI 

75  IITEGER*2  LIICTR.PGCTR.LIHPPG 

76  IITEGER*2  EBDFLG .  OLD,  lEW 

77  C******* 

78  REAL*4  XMED , RAIGEl .RAIGE2. AMSF.SFl .SF2 

79  REAL*4  ARRAY( 100) . XI , X2 .GRPHR 

80  REALM  PRESS, TEMP, AMBBS.KTINE 

81  REALM  GYRHR.DTIME.DGRPHR, OFFSET 

82  REAL*8  ACl ,AC2,AC3,BD1 ,BD2,BD3,T1.T2,T3.T4 

S3  c******* 

84  PARAMETER(TT1='  TTl’,  TT2=’  TT2’) 

86  PARAMETER  (MEDl  =’MED1’,  MED2  =  'MED2’,  M0D1=’M0D1’.  M0D2=’M0D2’) 

86  PARAMETER (PR= ’ PR ’ , TP= ’ TP ’ , AM= ’ AM  * ) 

87  PARAMETER(LIIPPG=64.  YES  =  ’YE’) 

88  PARAMETER(KR=6.  KW=6,  KWDA=7.  KWDB=8,  KWLA=9,  KWLB=10) 

89  C******* 

90  COMMOf/COMMED/  lARRAY 

91  COMMOI/COMMOD/  ARRAY 

92  COMMOI/MEMOCM/XMED , IGOODP , SDQRT , KT 

93  COMMOI/PARAM/BSKIP, IFIRST, LBURST 

94  COMMOI/UIIT/KRBUIS, RDFMT 

96  COMMOI/PCOEF/ ACl , AC2 . AC3 . BD 1 , BD2 , BD3 . T 1 . T2 . T3 . T4 

96  COMMOI/TCOEF/TREFl ,TREF2 . CTREFl , CTREF2 , TSEC . LAB 

97  COMMOI/PRSEqi/  Eqi.OVERIG 

98  C0MM0B/IIDX/KF1.KL1,KF2,KL2 

99  c******* 

100  lAMELIST/CARDl/  HEADR 

101  IAMELIST/CARD2/  ITT,  TTYPE 

102  IAMELIST/CARD3/  IWORDS.  LBURST,  LBFST.  RDFMT 

103  IAMELIST/CARD4/  ISEI.  SEISOR,  SWDIO 

104  IAMELIST/CARD6/  SFl,  SF2 ,  AMSF 

106  IAMELIST/CARD6/  IFIRST,  IFSEq.  BLAST,  ILSEO,  SEqilC 

106  IAMELIST/CARD7/  LBIDl,  UBIDl,  LBID2 .  UBID2.  DGRPHR 


107 

108 

109 

110 
111 
112 

113 
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115 
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131 

132 

133 

134 

135 

136 

137 

138 

139 

140 

141 

142 

143 

144 

145 
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154 

155 

156 

157 

158 

159 

160 


IAMELIST/CARD8/  lOPT 

IAMELIST/CARD9/  lYR,  MITH,  IDAY,  IHOUR,  MIIUT,  ISEC,  ISEQO 
lANELIST/CARDlO/  EQI.OVERIG 
lAMELIST/CARDll/  ACi.aC2.AC3 
IANELIST/CAR012/  BD1.BD2.BD3 
lAMELI ST/CARD 13/  T1.T2.T3.T4 

RAMELIST/CARD 14/  LAB . TSEC . TREFl . TREF2 . CTREFl . CTREF2 

C******* 

DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
DATA 
fl 

writeC* .42) 

42  format (IX.//’  PROGRAM  IS  RUIIIIG.  PLEASE  WAIT.’.//. 

«’  HAVE  SOME  JAVA! !’ .//) 

C«**«**«  OPEI  THE  COITROL  CARD  FILE  AfD  LOG  FILE. 

C«**«***  the  I/O  FILES  WILL  BE  OPEMED  LATER  AS  lEEDED 

(;«**«*«* 

OPEI(UIIT=KR,  STATUS=’OLD’ .  FORM= ’ FORMATTED ’ .  READGALY) 
OPEI(U*IT=KW.  STATUS='1EW’ .  FORM=’ FORMATTED’) 

C*******  READ  THE  COITROL  PARAMETERS  FOR  TYPES  OF  lES 

READ(KR.IML=CARD1) 

READ(KR,IML=CARD2) 

READ(KR.IML=CAR03) 

READ(KR.INL=CARD4) 

READ(KR.INL=CAR05) 

READ(KR.INL=CAR06) 

READ(KR.1ML=CARD7) 

READ(KR.IML=CARD8) 

REA0(KR.IML=CARD9) 

C******* 

c*******  read  II  COITROL  PARAMETERS  FOR  THOSE  WITH  ADDITIOIAL  SEISORS 

C******* 

IFCISEI  .IE.  0)  THEI 
READ(KR.IML=CARD10) 

READ(KR.IML=CAR011) 

READ(KR,IML=CARD12) 

READ(KR.IML=CARD13) 

READ(KR,IML=CARD14) 

EID  IF 


KRBUIS/11/ 

TYPEQI/’AB’ . ’CD’/ 

LIICTR/60/.PGCTR/0/ 

TT1SW/0/.TT2SW/0/.PRCES1/0/.PRCES2/0/ 

EIDFLG/0/.  OFFSET/O.O/.IPASS/O/ 

SFl /20480 . 0/ . SF2/20480 . 0/ . ZERO/O/ . FOUR/4/ 
RECII/0/.I0PT/6*’  ’/ 

PRESS/-99 .  /  ■'EMP/-99 .  / ,  AMBIS/-99 .  / 

SEISOR/3*’  /.SWDIO/0.0,0/ 

PRSI/0/ .TPSI/0/ . AMSI/0/ 

TREFl/0 . / .TREF2/0 . / . CTREFl /O/ .CTREF2/0/ 
LAB/O/.TSEC/O.O/.  MIDOPT/0/ 

TWOPWR/2 .4.8.16.32.64.128,256,512. 1024 . 2048 . 4096 , 8192 , 
16384 , 32768 , 65536 . 131072/ 
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161 

162 

163 

164 

165 

166 

167 

168 

169 

170 

171 

172 

173 

174 
176 

176 

177 

178 

179 

180 
181 
182 

183 

184 

185 

186 

187 

188 

189 

190 

191 

192 

193 

194 

195 

196 

197 

198 

199 

200 
201 
202 

203 

204 

205 

206 

207 

208 

209 

210 
211 
212 

213 

214 


C*****«« 

c**««#*«  CHECK  FOR  OVERRIIGIIG  OF  EITHER  TTl  OR  TT2 

C«*««*«*  ASSUMES  THAT  OILY  OIE  ilLL  OVERRAIGE  DLT.irC  A  DEPLOYMEIT. 

C*******  RESETS  THE  UPPER  BOUID  IF  lECESSARY. 

46  IFCUBIDl  .LT.  LBIDl)  THE! 

MID0PT=1 

DO  500  LP=1.17 

i0W2=TW0PWR(LP) 

IF(I0VI2  .GE.  LBIDl)  THEI 
PWR2=I0V2 
PMID=TW0PWR(LP-1) 

UBID1=UBID1+PHR2 
GO  TO  505 
EID  IF 

600  COITTIUE 
EID  IF 
506  COITIIUE 

IF(UB«D2  .LT.  LBID2)  THEI 
MID0PT=2 
DO  610  LP=1.17 
I0W2=TH0PWR(LP) 

IF(I0W2  .GE.  LBID2)  THEI 
PWR2=I0H2 
PM1D=TWQPWR(LP-1) 

UBID2=UBID2+PWR2 
GO  TO  626 
EID  IF 

510  COITIIUE 
EID  IF 
626  COITIIUE 

C******* 

c*******  WRITE  OUT  THE  COITROL  PARAMETERS 

C******* 

WRITE(KW,310)  HEADR 

310  F0RMAT(T20,’  MEMOD  PROGRAM  OUTPUT  *****’/T10,A60//) 

WRITE(KW,316)  ITT. (TTYPE(I) , 1=1 . 2) .ISEI, (SEISOR(I) , 1=1 , 3) 

315  FORMATC  THE  FOLLOWIIG  SEISORS  ARE  AVAILABLE:  '/ 
fl  110,'  TRAVEL  TIME  DETECTORS:  '.2A4/ 

Clio,’  ADDITIOIAL  SEISORS:  ' .3(A2,2X)//) 

WRITE(KW , 320)  IFIRST . IFSEQ , lUST . ILSEQ . DGRPHR , SEqilC . LBURST 
320  FORMAT ( 

C’  RECORD  #"S’,I8,’  (SEQ  #  ’,18,’)  THRU  ’,I8,’(SEQ  #’,I8,')’, 

C’  WERE  PROCESSED’//’  SAMPLIIG  RATE  IS  ’,D15.9, 

C’  DATA  GROUPS  PER  HOUR(SEQIIC  =  ’.15.’)’// 

C’  ’,110,’  DATA  POUTS  WERE  USED  FOR  EACH  MEDIAI  VALUE’///) 

WRITE ( KW . 330 ) LBID 1 . UBID 1 . LBID2 . UBID2 . ( lOPT ( I ) , I = 1 , 6 ) 

330  FORMAT(’  PROCESSIIG  PARAMETERS:’// 

C’  ’ ,4X, ’TTIMII’ ,4X, ’TTIMAX’ .41. ’TT2MII’ ,4X, ’TT2MAX’/’  ’.4110// 
C  ’  OPTIOIS  II  EFFECT  =  ’.6{2X.A4)/ 

C  lOX,’  lOTE:  TT2  IS  OILY  PROCESSED  BY  MEDIAI’//) 

WRITE(KW,332)  SF1,SF2,AMSF 

332  FORMATC  SCALIIG  FACTORS  FOR  TTl,  TT2,  AID  AMBIS  ARE:  ’, 
C3F10.2//) 


215  IF(MIDOPT  .IE.  0)  WRITE(KW.335)  MID0PT.PMR2 . PMID 

216  336  FORMATC  TT  DETECTOR  #’,12.'  WAS  FOLDED  TO  AVOID’, 

217  «  ’  WRAP-AROUID’/ 

218  fl  IX. 110,’  WAS  ADDED  TO  ALL  POUTS  LESS  THAI’,  110//) 

219  IFCISEI  .EQ.  0)  GO  TO  48 

220  IF(EQI  .EQ.  TYPEQI(l))  WRITE(KW.344) 

221  344  FORMATC’  PAROS  EQUATIOI  USED:  P  =  A(1-T0/T)  -  B(l-T0/T)**2’ ) 

222  IF(Eqi  .EQ.  TYPEQI(2))  WRITE(KW.346) 

223  346  FORMATC’  PAROS  EQUATIOI  USED:  P  =  C'CCl  -  (T0/T)**2]  -  ’, 

224  C  ’D[l  -  (T0/T)**2]**2}’) 

225  IFCOVERIG  .EQ.  YES)  WRITE(KW.348) 

226  348  FORMATC’  PRESSURE  OVER-RAIGED  AT  DEPTH  2**24  ADDED  TO  THE  COURTS ’) 

227  WRITECKW.341)  ACl . AC2. ACS .BDl .BD2 .BD3.T1 ,T2.T3.T4 

228  341  FORMATC’  PRESSURE  COEFFICIEITS: ’// 

229  C6X. ’ACl’ .IIX, ’AC2’ .IIX, ’AC3’/3C1X.D12.S,1X)/ 

230  C6X. ’BDl’ ,11X. ’BD2’ .IIX, ’BD3’/3C1X,D12.6.1X)/ 

231  eeX, ’T1 ’ . 12X, ’T2’ ,12X. ’T3’ .12X. ’T4’/4ClX.D12.6,lX)//) 

232  WRITE CKW. 342)  TSEC .TREFl .TREF2 .CTREFl ,CTREF2 

233  342  FORMATC’  SAMPLIIG  TIME  CSEC)  FOR  PRESS  AID  TEMP  IS’,F10.5// 

234  B’  CALIBRATIOI  TEMPERATURES:  ’.2F10.5/ 

236  C’  COURTS:  ’.2110) 

236  C******* 

237  C*******  SET  OPTIOI  SWITCHES 

238  C******* 

239  48  DO  50  1=1,6 


240 

IF  CIOPTCI)  .EQ.  1 

NEDl)  THEI 

241 

PRCES1=1 

242 

ELSE  IF  CIOPTCI) 

.EQ.  ME02)  THEI 

243 

PRCES2=1 

244 

ELSE  IF  CIOPTCI) 

.EQ.  NODI)  THEI 

245 

PRCES1=0 

246 

ELSE  IF  CIOPTCI) 

.EQ.  M0D2)  THEI 

247 

PRCES2=0 

248 

ELSE  IF  CIOPTCI) 

.EQ.  TT2)  THEI 

249 

TT2SW=1 

250 

0PEICUIIT=KWDB,  STATUS=’IEW’ , 

FORM=’ FORMATTED’) 

261 

0PEICUIIT=KWLB 

,  STATUS=’IEW’ . 

FORM=’ FORMATTED’) 

252 

ELSE  IF  CIOPTCI) 

.EQ.  TTl)  THEI 

253 

TT1SW=1 

264 

0PEICUIIT=KWDA 

,  STATUS=’IEW’ , 

FORM=’ FORMATTED’) 

256 

opeiCuiit=kwla 

,  STATUS=’IEW’ . 

FORM=’ FORMATTED’) 

256 

EID  IF 

267 

60  COITIIUE 

258 

IFCISEI  .IE.  0)  THEI 

259 

DO  56  I  =  1,  3 

260 

IF  CSEISORCI) 

.EQ.  PR)  THEI 

261 

PRSI  =  1 

262 

PRWDIO  =  SWDIOCI) 

263 

63  ELSE  IF  CSEISORCI)  .EQ.  TP)  THEI 

264 

TPSI  =  1 

265 

TPWDIO  =  SWDIOCI) 

266 

54  ELSE  IF  CSEISORCI)  EQ.  AM)  THEI 

267 

ANSI  =  1 

268 

ANWDIO  =  SWDIOCI) 

82 


269 

EID  IF 

270 

55  COITIIUE 

271 

EID  IF 

272 

c******* 

273 

C*******  OPEI  THE  BUIS  IIPUT  DATA  SET  DEPEIDIIG  01  THE  FORMAT 

274 

275 

IF  (RDFMT  .EQ.  0)  THEI 

276 

OPEI(UIIT=KRBUIS.  STATUS= ' OLD ' ,  FORM= ' UIFORMATTED 

') 

277 

ELSE 

278 

OPEI(UIIT=KRBUIS.  STATUS= ' OLD  * .  FORM= ' FORMATTED ' ) 

279 

EID  IF 

280 

281 

C:»**«***  CALCULATE  THE  TIME  BASE: 

1 

1 

282 

C*******  time  is  REFEREICED  to  SEQUEICE  IUMBER  ISEQO,  assumes  THAT  < 

283 

c**«**«*  time  is  GIVEI  as  GMT.  THE  MEDIAI  TIME  ASSOCIATED  WITH 

284 

C*******  ALL  RECORDS  IS  OFFSET  TO  PLACE  IT  II  THE  MIDDLE  OF 

THE  SAMPLE 

285 

C*******  BURST 

286 

C*****«*  WRITE  OUT  TIME  BASE  TO  LOG. 

287 

288 

65  COITIIUE 

289 

CALL  YRDAY(IYR.MITH.IDAY.IYRDAY) 

290 

CALL  GMTYR ( lYRDAY . IHOUR .MIIUT . ISEC , GYRHR , ZERO , FOUR) 

291 

OFFSET=DFLOAT(LBURST- 1 ) * 10 . 0/7200 . 0 

292 

GYRHR  =  GYRHR  +  OFFSET 

293 

WRITECKW , 354)  ISEQO . lYR ,MITH , IDAY , IHOUR. MIIUT , ISEC 

294 

354  FORMAT(//’  TIME  BASE  PARAMETERS:'/ 

295 

«'  SEQUEICE  IUMBER' ,110, '  IS  ASSIGIED  THE  FOLLOWIIf'-  TIMS;’/ 

296 

«8X, 'lYR' ,6X, 'MITH' ,6X,'IDAY' ,5X. 'IHOUR* , 5X , 'MIIUT' , 6X 

,  'ISEC' , 

297 

«/lX,6I10) 

298 

WRITECKW, 355)  GYRHR, ISEQO 

299 

355  FORMATC/’  GYRHR  =',D15.9,'  FOR  ISEQO  ='.110//) 

300 

c**««==* 

301 

c===**«*  CALCULATE  TOTAL  IUMBER  OF  ECHOS  AID  RAIGES  OF  THEM 

302 

c«****== 

303 

KOUIT  =  LBURST  •  ITT 

304 

IF  (TTISW  .IE.  0)  THEI 

305 

RIINII  =  FLOAT(LBIDl) 

306 

RIIMAX  =  FLOAT(UBIDl) 

307 

RAIGEl  =  (RIIMAX  -  RIIMII)  /SFl 

308 

EID  IF 

309 

IF  (TT2SW  .IE.  0)  THEI 

310 

RI2MII  =  FL0AT(LBID2) 

311 

RI2MAX  =  FLOAT (LBID2) 

312 

RAIGE2  =  (RI2NAX  -  RI2MII)  /SF2 

313 

EID  IF 

314 

c******* 

315 

C*««**«*  EITER  NAII  PROCESSIIG  LOOP 

316 

c******* 

317 

6666  COITIIUE 

318 

c==****= 

319 

c*=**=*«  WRITE  PAGE  HEADIIG  TO  LOG  IF  lEEDED 

320 

321 

c*«««*** 

322 

IF  (LIICTR  .GE.  LIIPPG)  THEI 

>(3 


323  LIICTR=0 

324  PGCTR  =  PGCTR  +  1 

325  600  IF  (TTISW  .IE.  0)  THEI 

326  IF  (PRCESl  .IE.  1)  THEI 

327  WRITE(KMLA.410)  HEADR, PGCTR 

328  ELSE 

329  602  WRITE(K¥LA,400)  HEADR, PGCTR 

330  EID  IF 

331  604  «RITE(KWLA.415) 

332  EID  IF 

333  606  IF  (TT2SW  .IE.  0)  THEI 

334  IF  (PRCES2  .IE.  1)  THEI 

335  URITE(KWLB,410)  HEADR,  PGCTR 

336  ELSE 

337  606  WRITE(KWLB,415)  HEADR, PGCTR 

338  EID  IF 

339  608  WRITE(KWLB,416) 

340  EID  IF 

341  EID  IF 

342  400  F0RMAT(1H1,T10,A60,T110, 'PAGE’ ,I4,//T8, ’SEQ#’ ,T20, ’MEDIAI’ , 

343  e  T32, 'QUARTILE' ,T46, ’#G00D’ ,T61, 'XO' ,T69, 'PRESS  DBAR' , 

344  «  T83, 'TEMP  (C) ’ ,T96, 'AMB  lOISE’ ,T109, ’TIME(IIID) ’) 

346  410  F0RMAT(1H1,T10,A60,T110, 'PAGE' ,I4,//T8, 'SEQ#' ,T19, ’  MODE’, 

346  «  T35, ’SD’ ,T46, ’#GOQD’ ,T61, ’XO’ ,T69, ’PRESS  DBAR’ , 

347  «  T83,’TEMP  (C)’,T96,’AMB  I0ISE’,T109,’TIME(MID)’) 

348  416  FORMAT(’+  ’,9(’ _ ’.3X)) 

349  C******* 

360  C*******  READ  II  THE  DATA. 

361  c*******  IICREMEIT  COUITER  AID  SET  SEQIO 

352  C***'**** 

363  610  COITIIUE 

364  CALL  RDBUIS(IUaRDS,IX) 

356  RECII  =  RECII  +  1 

356  SEqia=IX(l) 

357  C******* 

368  C*******  SKIP  UIWAITED  RECORDS.  IF  FIRST  OIE  TO  PROCESS, 

359  c*«**««*  MAKE  SURE  THE  SEQUEICE  lUMBER  IS  THE  OIE  EXPECTED. 

360  C******* 

361  IF  (IPASS  .LE.  0)  THEI 

362  IFCRECII  .LT.  IFIRST)  GO  TO  610 

363  IFCSEQIO  .EQ.  IFSEQ)  GO  TO  626 

364  VRITE(KV,368)  RECII , SEQIO , IFSEQ 

366  368  F0RMAT(6X, ’•••*•  RUI  TERMIIATED 

366  C  /’  FOR  RECORD  #  ’,18,’  FIRST  SEQIO  WAS  ’,18.'  IISTEAD  OF  ’,18) 

367  STOP  368 

368  EID  IF 

369  C******* 

370  C*******  CHECK  FOR  LAST  RECORD  TO  BE  PROCESSED 

371  C*******  WRITE  A  WARIIIG  IF  RECII  GETS  BIGGER  THAI  EXPECTED 

372  c******* 

373  616  COITIIUE 

374 

376  IF  (RECII  .EQ.  ILAST)  THEI 

376  EIDFLG  =  1 
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377  ELSE  IF  (RECII  .GE.  ILAST)  THEM 

378  620  URITE(KW.362)RECII,IUST.SEqiO 

379  362  FORNATC'  VARIIIG:  ILAST  EXCEEDED!  CHECK  SEqUEICE  lUNBERS .  '/ 

380  «  ’  RECII  =  MIO,'  ILAST  =  ',110. 5X.'  SEqiO  =  '.110/ 

381  «  '  THIS  GROUP  HAS  BEEI  IICLUDED  II  THE  DATA  SET’/ 

382  «  ’  PROGRAM  TERMIIATES  lORMALLY. ’//) 

383  EIDFLG  =  1 

384  EID  IF 

385  c******* 

386  C*******  CHECK  FOR  EID  OF  FILE  H.AG.  OTHERWISE,  THIS  RECORD 

387  C*******  IS  TO  BE  PROCESSED.  REIANE  THE  VARIABLES 

388  c******* 

389  626  COITIIUE 

390  IF(SEqiO  .Eq.  -1)  GO  TO  7000 

391  IFCPRSI  .Eq.  1)  IPRESS  =  IX(PRWDIO) 

392  IF(TPSI  .Eq.  1)  ITEMP  =  IX(TPWDIO) 

393  IFCAMSI  .Eq.  1)  lANBIS  =  IX(ANWDIO) 

394  DO  626  K=1.K0UIT 

396  IXB(K)=IX(K+LBFST-1) 

396  626  COITIIUE 

397  C******* 

398  C*******  ASSIGI  THE  TIME  TO  THE  MIDDLE  OF  THE  GROUP  IITERVAL 

399  C******* 

400  DTIME  =  GYRHR  +  (DFLOAT(SEqiO  -  ISEqO)/DGRPHR)/DFLOAT(SEqiIC) 

401  MTIME  =  DTIME 

402  C******* 

403  C*******  WRITE  OUT  COURTS  OF  FIRST  SAMPLIIG  PERIOD  TO  LOG  FILE 

404  C******* 

406  IF(SEqiO  .Eq.  IFSEq)  WRITE(KW,360)SEqi0, DTIME, 

406  «  (IXB(J),J=1.K0UIT) 

407  360  FORMAT (//1H1.4X  'FIRST  POUTS  READ:’//’  SEqiO  =’,I10, 

408  «  ’  DTIME  =  ’ ,E15.9/(4(2X,2I10))) 

409  C******* 

410  C*******  CALCULATE  THE  REAL  PRESSURE  AID  TEMPERATURE,  IF  lECESSARY 

411  C******* 

412  IFCPRSI  .Eq.  1)  CALL  TEMPRSCIPRESS, ITEMP. PRESS, TEMP) 

413  C******* 

414  C*******  CALCULATE  THE  AMBIEIT  lOISE,  IF  lECESSARY 

415  C******* 

416  IFCAMSI  .Eq.  1}  AMBIS  =  lAMBIS/AMSF 

417  C******* 

418  C*******  IF  OVERRAIGIIG,  WRAP  EITHER  TTl  OR  TT2 .  WILL  HOT  DO  BOTH 

419  C******* 

420  IF  CMIDOPT  .IE.  0)  THEI 

421  DO  630  J=MIDOPT,KOUIT.ITT 

422  IF  CIXBCJ)  LT.  PMID)  IXBCJ)  =  IXBCJ)  +  PWR2 

423  630  COITIIUE 

424  EID  IF 

426  636  COITIIUE 

426  C******* 

427  C*******  ORDER  THE  DATA 

428  c******* 

429  CALL  RESORTCKOUIT.nr.IXB.IXX) 

430  C******* 
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431 

PROCESS  TTl  IF  DESIRED 

432 

IF  2  TT  DETECTORS  USED.  PASS  OILY  the  FIRST  HALF  OF  IXX 

433 

OTHERWISE  ALL  COUITS  WILL  BE  PASSED. 

434 

c******* 

CHECK  WHETHER  TO  USE  MODE  OR  MEDIAI  PROCESS 

435 

c******* 

436 

IF 

(PRCESl  .EQ.  0)  THEI 

437 

KT  =  0 

438 

DO  640  K=KF1.  KLl 

439 

KT  =  KT  +  1 

440 

ARRAY(KT)  =  IXX(K) 

441 

640 

COITIIUE 

442 

CALL  TTMODE(SEqiO,RIlMII,RIlMAX) 

442 

ELSE 

444 

642 

COITIIUE 

445 

KT  =  0 

446 

DO  644  K=KF1,  KLl 

447 

KT  =  KT  +  1 

448 

lARRAY(KT)  =  IXX(K) 

449 

644 

COITIIUE 

450 

CALL  TTMEDKLBIDl.UBIDl) 

451 

EID  IF 

452 

453 

SCALE  THE  COUITS  TO  SECOIDS  AID  WRITE  TO  DISK 

AID  LOG 

454 

455 

646  XI 

=  XMED/SFl 

456 

WRITE(KTOA .420)  XI, PRESS . TEMP . AMBIS , MTIME 

457 

420  F0RMAT(S(2X,E13.7)) 

458 

WRITE (KWLA , 426 ) SEQf 0 . XMEO . SDQRT , IGOODP , XI , PRESS , TEMP , AMBIS , : 

459 

425  F0RMAT(3X,I10,2(3X,F10.2),3X,I10.5(2X,F11.4)) 

460 

C**4>«*** 

461 

PROCESS  TT2  IF  DESIRED 

462 

c******* 

IF  2  TT  DETECTORS  PASS  OILY  THE  SECOID  HALF 

OF  IXX 

463 

464 

660  IF 

(TT2SW  .IE.  0)  THEI 

465 

IF(PRCES2  .EQ.  0)  THEI 

466 

KT  =  0 

467 

DO  662  K=KF2.KL2 

468 

KT  =  KT  +  1 

469 

ARRAY(KT)  =  IXX(K) 

470 

652 

COITIIUE 

471 

CALL  TTM0DE(SEqi0,RI2MII,RI2MAX) 

472 

ELSE 

473 

KT  =  0 

474 

DO  666  K=KF2,KL2 

476 

KT  =  KT  +  1 

476 

lARRAY(KT)  =  IXX(K) 

477 

656 

COITIIUE 

478 

CALL  TTMEDI(LBID2,UBID2) 

479 

EID  IF 

480 

c***«*** 

481 

SCALE  FROM  COUITS  TO  SECOIDS,  AID  WRITE  TO  DISK  AID  LOG 

482 

c******* 

483 

X2  =  XME0/SF2 

484 

WRITE (KWDB , 420) X2 , PRESS , TEMP , AMBIS . MTIME 
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485 

WRITE (KWLB , 426) SEQI 0 ,XMED . SDQRT . IGOODP , X2 , PRESS , 

,TEMP,AMBKS,MTIME 

486 

EID  IF 

487 

488 

c*****««  EID  of  Mill  PROCESSIIC  LOOP 

489 

C4>«4>****  IICREMEIT  THE  COUITERS,  CHECK  FOR  EID  OF  DATA 

490 

491 

IPASS=IPASS+1 

492 

LIICTR  =  LIICTR  +  1 

493 

IF  (EIDFLG  .EQ.  1)  GO  TO  7100 

494 

GO  TO  6666 

495 

496 

UIEXPECTED  EID  OF  DATA  TERMIIATE  PROGRAM 

497 

c******* 

498 

7000  COITIIUE 

’I 

499 

WRITE(KW,370) 

j 

500 

370  F0RMAT(//6X, ’  UIEXPECTED  EID  OF  DATA  -  RUI  TERMIIATED’) 

501 

c******* 

502 

c*******  lORMAL  EID  OF  PROCESSIIG  WRITE  MESSAGE  TO  LOG 

503 

(;*«*«**« 

504 

7100  COITIIUE 

506 

WRITE (KW , 376 )  SEQIQ . DTIME . (IXB( J ) . J= 1 . KOUIT) 

506 

376  F0RMAT(//1H0.4X. ’LAST  POUTS  READ:’//’  SEQIO  =’,110, 

507 

€  ’  DTIME  =  ’ ,E15.9/(4(2X,2I10))) 

508 

509 

C*******  WRITE  TTl  PROCESSIIG  MESSAGES 

510 

C**000*» 

511 

IF  (TTISW  .IE.  0)  THEI 

512 

IF  (PRCESl  .EQ.  0)  THEI 

513 

7126  WRITE(KW,390)  IPASS,TTYPE(1) ,RAIGE1 

514 

ELSE 

516 

WRITE(KW,380)  IPASS.TTYPEd)  ,RAIGE1 

516 

EID  IF 

517 

EID  IF 

518 

c******* 

519 

c#*****«  WRITE  TT2  PROCESSIIG  MESSAGES 

520 

521 

7130  IF  (TT2Sy  .IE.  0)  THEI 

522 

IF(PRCES2  .EQ.  0)  THEI 

523 

7132  WRITE(KW,390)  IPASS,TTYPE(2) ,RAIGE2 

524 

ELSE 

525 

WRITE(KW,380)  IPASS ,TTYPE(2) ,RAIGE2 

526 

EID  IF 

627 

EID  IF 

528 

380  F0RMAT(/5X,I10, ’  RECORDS  WERE  WRITTEI  TO  THE’,A4,’ 

MEDIAI 

DATASET 

529 

«’/  16X,’RAIGE  OF  DATA  IS  ’,F10.5,’  SEC') 

530 

390  F0RMAT(/6X,I10, ’  RECORDS  WERE  WRITTEI  TO  THE’,A4,' 

MODAL  DATASET 

631 

6’/  16X,’RAIGE  OF  DATA  IS  ',F10.5.’  SEC’) 

532 

396  F0RMAT(/6X.I10, ’  RECORDS  WERE  WRITTEI  TO  THE’,A4,’ 

MEDIAI 

DATASET 

533 

6’/  15X,’RAIGE0F  DATA  IS  ’,F10.6,’  SEC’) 

534 

WRITE (*.43) 

535 

43  FORMATdX,//,  ’  AH  HA!!  lOW  YOU  GOT  TO  DO  SOME  WORK!!’ 

536 

«,//,’  I  AM  FIIISHED  -  SO  HAVE  FUI!!  ’,//) 

637 

STOP 

538 

EID 

539  c******* 

541  C******* 

542  C*******  SUBROUTIIES 

543  C******* 

544  c******* ********************************************** **************** 

545  c******* 

546  SUBROUTIIE  ROBUIS(IWOROS , II) 

547  COMMOI/UIIT/KRBUIS . RDFMT 

548  IITEGER*4  II( 100) .RDFMT 

549  C******* 

550  C*******  READ  EITHER  BIIARY  OR  FORMMATTED  DATA 

551  c******* 

552  IF(RDFMT  .EQ.  0)  THEI 

553  READ(KRBUIS.EID=99)(II(I) ,I=1.IW0RDS) 

554  ELSE 

555  90  READ(KRBUIS,89,EID=99)  (II(I) ,1=1 .lUORDS) 

556  89  F0RMAT(8I10) 

557  EID  IF 

558  RETURI 

559  99  II(1)=-1 

560  100  COITIMUE 

561  RETURI 

562  EID 

563  C******* 

564  C******************************************************** ****** ******** 

565  C******* 

586  SUBROUTIIE  RESORT (KOUIT, ITT. XB, OUT) 

567  c******* 

568  C*******  lEW  VERSIOI  OF  THE  S/R  ORDER 

569  C*******  THIS  PUTS  ALL  THE  COURTS  FROM  OIE  DETECTOR  lEXT  TO  EACH  OTHER 

570  C*******  AID  PUTS  THE  COURTS  FROM  THE  SECOID  OIE  AFTER  THOSE  OF  THE 

571  C*******  FIRST.  OILY  THEI  ARE  THE  COURTS  FROM  EACH  DETECTOR  SORTED 

572  C*******  FROM  LOW  TO  HIGH 

573  C******* 

574  COMMOI/IIDX/  KFl .KLl .KF2 .KL2 

575  IITEGER*4  0UT(226) ,TEMP.XB(226) 

576  C******* 

577  C*******  COPY  XB  TO  OUT.  KEEP  TRACK  OF  IIDEX  OF  FIRST  AID  LAST 

578  C*******  TT  FROM  BOTH  DETECTORS. 

579  c******* 

580  K  =  0 

581  DO  20  1=1. ITT 

582  DO  10  J=I,KOUIT.ITT 

583  K=K+1 

584  OUT(K)  =  XB(J) 

585  10  COITIIUE 

586  KLl  =  K 

587  KF2  =  K+1 

588  20  COITIIUE 

589  KFl  =  1 

590  KL2  =  KOUIT 

591  C******* 

592  C*******  SORT  THE  MEMBERS  OF  FIRST  TT  DETECTOR  FIRST. 
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693  C*******  THE!  SORT  THE  SECOID  TT  MEMBERS. 

594  c******* 

595  LiST  =  KOUIT  -  ITT 

696  DO  60  II  =1,ITT 

597  IF  (II  .GT.  1)  GO  TO  26 

598  IFST  =  KFl 

699  ILST  =  KLl 

600  GO  TO  26 

601  25  COITIIUE 

602  IFST  =  KF2 

603  ILST  =  KL2 

604  c****** 

606  c******  teat  for  removing  no  echos 

606  c****** 

607  26  dc  59  i=l,24 

608  if  ((out(i) .eq. 4351) .or. (out(i) .eq. 4362))  out(i)=-out(i) 

609  59  continue 

610 

611  DO  50  I  =  IFST.  ILST 

612  IF  (OUT(I)  .LE.  0UT(I+1))  GO  TO  50 

613  J  =  I  +  1 

614  TEMP  =  OUT(J) 

616  30  K  s  J  -  1 

616  IF  (OUT(K)  .LE.  TEMP)  GO  TO  40 

617  CUT(J)  =  OUT(K) 

618  J  s  J  -  1 

619  IF  (J  .GT.  II)  GO  TO  30 

620  40  Oirr(J)  =  TEMP 

621  60  COITIIUE 

622  60  COITIIUE 

623  RETURI 

624  EID 

626  C******* 

626  C********************************************************************** 

627  C******* 

628  SUBROUTIIE  TTMEDI(RIMII .RIMAX) 

629  C*******  TAKES  MEDIAI  OF  ARRAY  XX. 

630  C****e**  FIRST  WIIDOWS  ARRAY  WITHII  RAIGE  =  (RIMII , RIMAX) 

631  Ce******  RETURIS  IGOODP  (#  GOOD  POUTS  )  WITHII  RAIGE 

632  C*******  AID  CALCULATES  MEDIAI  AID  QUARTILE  RAIGE  OF  THOSE  POUTS 

633  C*******  ORIGIIALLY  WRITTEI  SEPT  1978,  A.  CUTTIIG 

634  C*******  REWRITTEI  BY  K.  TRACEY  JULY  1986:  lOW  ALL  CALCULATIOIS 

635  Ceeeeee*  ARE  DOIE  AS  IITEGERS.  TBEI  PASSED  BACK  AS  REALS. 

636  c******* 

637  COMMOI/COMMED/  XX 

638  COMMOI  /MEMOCM/  XMED,  IGOODP,  QUART,  LBURST 

639  IITEGERM  RIMII, RIMAX.  XX (100) 

640  c******* 

641  C*******  ELIMIIATE  THE  OUT  OF  RAIGE  RAW  DATA  POUTS 

642  C***e*ee 

643  IBOT  =  1 

644  42  IF  (XX(IBOT)  .GE.  RIMII)  GO  TO  44 

645  IBOT  =  IBOT  +  1 

646  IF  (IBOT  .LE.  LBURST)  GO  TO  42 
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647 

648 

649 

650 

651 

652 

653 

654 

655 

656 

657 

658 

659 

660 
661 
662 

663 

664 

665 

666 

667 

668 

669 

670 

671 

672 

673 

674 
676 

676 

677 

678 

679 

680 
681 
682 

683 

684 

685 

686 

687 

688 

689 

690 

691 

692 

693 

694 
696 

696 

697 

698 

699 

700 


XNED  =  RINII 
GO  TO  47 

C’****«4'* 

c******* 

44  COITIIUE 

ITOP  =  LBURST 

46  IF  (XX(ITOP)  .LE.  RINAX)  GO  TO  48 
ITOP  =  ITOP  -  1 

IF  (ITOP  .GT.  IBOT)  GO  TO  46 
XMEO  =  RINAX 

c**«##**  all  pouts  II  THE  IITERVAL  ARE  OUT  OF  RAIGE 

47  COITIIUE 
IGOODP  =  0 
QUART  =0.0 
RETURI 

c*******  COMPUTE  THE  MEDIAI  AID  THE  QUARTILE  OF  THE  GOOD  POUTS 
C******* 

48  COITIIUE 

IGOODP  =  ITOP  -  IBOT  +  1 
IIDMED  =  IBOT  +  IGOODP  /  2 
IIDQLO  =  IBOT  +  (IGOODP  +  2)  /  4 
IIDQHI  =  IIDQLO  +  (IGOODP  -  1)  /  2 
XNED  =  XX (IIDMED) 

QUART  =  XX(IIDQHI)  -  XX(IIDQLO) 

49  COITIIUE 
RETURI 
EID 

SUBROUTIIE  TEMPRS(PCT,TCT.PRS,TDEGC) 

C******* 

c*******  EQUATIOIS  USIIG  EITHER  THE  A,  B  OR  THE  C.D  COEFFIECIEITS . 
C*******  REVISED  JULY  1986  -  lOV  IICLUDES  THE  POSSIBILITY  OF 
USED  TEMP  (DEGC)  TO  CALCULATE  PRESS  FROM  THE  CD  EQI. 
C*******  this  is  DOIE  if  BDl  =  BD2 

C******* 

IITEGER*4  PCT , TCT , CTREFl , CTREF2 , LAB 
IITEGER*2  EQI,OVERIG,YES.TYPEQI 
REAL«4  PRS,TDEGC,TREF1.TREF2 

REAL*8  ACCIST , AC 1 , AC2 , BDCIST , BD 1 . BD2 . TCOIST , T1 , T2 , T , T3 
COMMOI/PCOEF/ACCIST , AC 1 , AC2 . BDCIST , BD 1 , BD2 , TCOIST . T1 , T2 . T3 
COMMOI/TCOEF/TREFl ,TREF2. CTREFl ,CTREF2,TSEC.LAB 
CONMOI/PRSEQI/  EQI.OVERIG 
EQUIVALEICE  (AC.A.C),  (BD,B,D} 

PARAMETER  (TW016=66636 ,  TW024=16777216) 

PARAMETER(YES='YE’ , TYPEQI= ' CD ’ ) 

C******* 

C***«**«  CHECK  FOR  OVERRAIGIIG,  THEI 

C*******  CALCULATE  PERIOD  (T)  FROM  PCT  OF  DATA  SAMPLE 
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701  C*******  WHERE:  T  =  SAMPLIIG  IITERVAL(II  SEC)  /  COUITS 

702  C******* 

703  IFCOVERIG  .EQ.  YES)  PCT=PCT+TW024 

704  c******* 

706  c*******  iY  a  zaro  count  ia  found  set  it  to  unity  to  prevent  zero  divide 

706  c*******  and  maJce  a  easily  distinguishable  spike. 

707  c******* 

708  if  (pct.eq.O)  pct=l 

709  T=TSEC/FLOAT(PCT) 

710  c******* 

711  C*******  CALCULATE  TEMPERATURE: 

712  C*******  IITERPOLATE  FOR  LAB  TESTS:  (T-T1)/(I-I1)  =  (T2-Tl)/(*2-Ml) 

713  C*******  IF  *0  LAB  CALIBRATIOIS.  USE  'IDEAL’  COIVERSIOI 

714  C******* 

716  IF(LAB  .EQ.  0)  TDEGC=FL0AT(TCT)*TREF1/TSEC 

716  IF(LAB  .EQ.  1)  TDEGC=TREF1+FL0AT(TCT-CTREF1)*(TREF2-TREF1)/ 

717  C  float((CTREF2-CTREFl)) 

718  C******* 

719  C*******  IF  BDl  =  BD2,  EQI  IS  CD  AKD  COEF  CALCULATED  FROM  TDEGC 

720  C*******  OTHERWISE: 

721  C*******  CALCULATE  TEMP-DEPEIDEIT  CDEFFICIEITS  A.B.TO 

722  C****^**  AID  C.D.TO  FROM  TDEGC 

723  C*******  THE!  DETERMIIE  IF  EQUATIOf  IS  AB  OR  CD  TYPE 

724  c******* 

725  IF(BD1.EQ.BD2)  GL  TO  40 

726  TDEGF=TDEGC* 1.80+32. 

727  AC=ACCIST+TDEGF*(AC1+AC2*TDEGF) 

728  BD=BDCIST+TDEGFe(BDl+BD2*TDEGF) 

729  T0=TC0IST+TDEGF*(T1+T2*TDEGF) 

730  IF(EQI.EQ.TYPEQl)  GO  TO  50 

731  c******* 

732  C*******  CALCULATE  PRESSURE  FROM  LIIEARIZATIOI  EQUATIOI: 

733  C*******  P=A(1-T0/T)  -  B(l-T0/T)**2 

734  c******* 

736  T0T1=1-T0/T 

736  PPSIA=T0T1*(A-B*T0T1) 

737  GO  TO  100 

738  C******* 

739  C*******  TEMP-DEPEIDAIT  COEFS  ARE  CALCULATED  FROM  TDEGC 

740  C*******  AID  EQI  IS  AUTOMATICALLY  CD  TYPE 

741  c******* 

742  40  COITIIUE 

743  AC=ACCIST+TDEGC*(AC1+AC2*TDEGC) 

744  BD=BDCIST 

746  T0=TC0IST+TDEGC*(T1+T2*TDEGC+T3*TDEGC*TDEGC) 

746  C******* 

747  C*******  CALCULATE  PRESSURE  FROM  PAROS  EQUATIOI: 

748  C*****e*  P=C{[1-(T0/T)**2]  -  D Cl-(T0/T)**2] •*2> 

749  C******* 

760  60  COITIIUE 

761  TOT=TO/T 

762  T0TSQ1=1-T0T*T0T 

763  PPSIA=C+(T0TSQ1  -  D  *  TOTSQl  *  TOTSQl) 

764  100  COITIIUE 


COIVERT  TO  DBAR  FROM  PSIi 


755  c******* 

756  C******* 

757  c******* 

758  PRS=PPSIA*0. 68947 

759  RETURI 

760  EID 

761  c******* 

762  C**************************************************** •**•***** ********* 

763  C******* 

764  SUBROUTIIE  TTMODE(LBLREC.Rimi.RIMAX) 

765  C*******  DETERMIIES  MOST  PROBABLE  (MODAL)  VALUE  OF  A  RAYLEIGH  DISTRI- 

766  C*******  BUTIOI  P(X)=(X-XM)*EXP(-(((X-XM)**2)/2.*SD**2) 

767  C*******  OF  SAMPLE  SIZE  =  IPTS  ...  BY  THE  METHOD  OF  MOMEITS ,  AFTER 

768  C*******  DESPIKIIG  RELATIVE  TO  QUARTILE  RAIGE  OF  SAMPLE 

769  C*******  REVISED  FROM  TTMOD,  SEPT  1978,  R.  WATTS 

770  C*******  REVISED  1  lOV  1982  BY  KRL: 

771  c*******  WIIDOWS  THE  DATA  BASED  01  MAX  AID  Mil  SUPPLIED  BY  USER 

772  C*******  BEFORE  DETERMIIIIG  THE  QUARTILE  RAIGE. 

773  C*******  REVISED  JULY  1985,  lEW  CQMMOI  BLOCK  IICLUDED  AID  CHOPS 

774  C*******  THE  DATA  BEFORE  PASSIHG  IT  BACK  TO  MAIM  PROGRAM 

775  c******* 

776  REAL*4  XM 

777  REAL*4  XX(IOO) .UPRLIM.LOWLIM 

778  COMMOI/COMMQD/  XX 

779  COMMOI/MEMOCM/XMOD , IGOODP , SD , IPTS 

780  PARAMETER  (KW=6) 

781  IITEGER*4  UCIT 

782  DATA  XM/0 . 0/ . UCIT/56/ 

783  c******* 

784  c*******  IIITIALIZE  PARAMETERS.  CHECK  VALUE  OF  IPTS. 

785  C****4'** 

786  IF(IPTS.LT.8)  GO  TO  50 

787  SM=0. 

788  SD=0.0 

789  c******* 

790  c*******  ELIMIIATE  THE  OUT  OF  RAIGE  POUTS  BEFORE  DETERMIIIIG 

791  C*******  THE  QUARTILE  RAIGE  OF  THE  RAYLEIGH  DISTRIBUTIDI 

792  C******* 

793  IB0T=1 

794  5  IF(XX(IBOT)  .GE.  RIMII)  GO  TO  10 

795  IB0T=IB0T+1 

796  IFdBOT  .LE.  IPTS)  GO  TO  5 

797  ngoodp=0 

798  XMOD  =  RIMII 

799  GO  TO  46 

800  10  COITIIUE 

801  ITOP=IPTS 

802  16  IF(XX(ITOP)  .LE.  RIMAX)  GO  TO  20 

803  IT0P=IT0P-1 

804  IFCITOP  .GT.  IBOT)  GO  TO  16 

805  ngoodp=0 

806  XMOD  =  RIMAX 

807  GO  TO  45 

808  20  COITIIUE 
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809  c******* 

810  c*******  bin  vlndov  the  data  using  the  routin*  binwindov.  See  docunentation 

811  c*******  accoaapanying  the  code  below 

812  c******* 

813  call  binwindouCibot , itop) 

814  c******* 

816  c*******  if  there  are  less  than  4  points  assign  xmod=the  up.sr  puna  limit. 

816  c*******  This  sill  flag  ignore  statistically  unreliable  estimates  as  sell  as 

817  c*******  out  of  range  ones. 

818  c******* 

819  IG00DP=IT0P-IB0T+1 

820  if  (ngoodp.lt. 4)  then 

821  ZJBod=mmaz 

822  goto  45 

823  endif 

824  c******* 

826  C*******  DETERMIIE  THE  QUARTILE  RAIGE  -  lOTE; 

826  C*******  RAYLEIGH  QUARTILE  RAHGE  =  .91  SIGMA 

827  C*******  FOR  THE  TTA  DETECTOR  THIS  SHOULD  BE  APPROXIMATELY  2  MSEC 

828  C******* 

829  176  =  IBOT  -  1  +  nint (3 . *float(IG00DP)/4 . ) 

830  150  =  IBOT  +  HGQODP/2 

831  f26  =  IBOT  -  1  +  nint(float(IG00DP)/4.) 

832  Q  =  XX(M75)  -  XX(I25) 

833  C******* 

834  C*******  IF  THE  QUARTILE  RAHGE  IS  GREATER  THAI  200.  (APPROXIMATELY 

836  C*******  10  MSEC)  THEI  THROW  OUT  THE  WHOLE  SAMPLE 

836  C******* 

837  IF  (Q  .GT.  200.)  GO  TO  40 

838  C***«**« 

839  C*******  THROW  OUT  EVERYTHIMG  OUTSIDE  THE  97TH  PERCEITILE  RAHGE 

840  c******* 

841  M=IB0T 

842  K=IT0P 

843  C******* 

844  C*******  DETERMIIES  UPRLIM  AID  LOWLIM  FROM  97TH  PERCEITILE  RAHGE 

846  C*******  ESTIMATED  FOR  RAYLEIGH  DISTRIBUTIOI,  BY  THE  RATIO  TO 

846  C*******  QUARTILE  RAHGE 

847  C******* 

848 

849  z****** 

860  c******  the  constants  in  this  equation  sere  changed  from 

861  c******  UPRLIM  =  XX(I60)  +  3.0*  Q 

862  c*****e  LOWLIM  =  XX(H60)  -  1.5*  Q 

863  z******  The  nes  constants  sere  found  using  the  equations: 

864  z******  variance=(2-pi/2)8igaa*2 

866  c******  mean  =  mu+8igma*(pi/2)'( . 6) 

866  c******  and  an  adjustment  to  estimate  the  uncertainty  in  the  node. 

867  c«e*«**  This  adjustment  sas  simply  a  standard  error  of  the  mean 

868  c******  error  of  the  mean  =  [Variance/(1-1)]'( .6) 

859  z******  I  sas  taken  to  be  16. 

860 

861  UPRLIM  =  XX(I60)  +  1.81  *  Q 

862  LOWLIM  =  XX(I60)  -  1.21  ♦  Q 
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863  DO  30  J=IBOT,ITOP 

864  IF  (XX(J)  .GT.  UPRLIM)  K  =  K  -  1 

865  IF  (XX(J)  .LT.  LOWLIM)  M  =  M  +  1 

866  30  COITIIUE 

867  C******* 

868  C*******  IGOODP  IS  THE  lUMBER  OF  XX  RETAIIED  FOR  MODAL  CALCULATIOI 

869  C******* 

870  IG00DP=K-M+1 

871  c******* 

872  C*******  SM  IS  THE  AVERAGE  VALUE  OF  X  HITHII  (M.K)  KEPT 

873  c******* 

874  DO  31  J=M.K 

875  SM=SM+XX(J) 

876  31  COITIIUE 

877  SM=SM/IGOODP 

878  c******* 

879  C*******  S  IS  THE  VARIAICE  (WHICH  IS  SCALED) 

880  C******* 

881  S=0. 

882  DO  33  J=M.K 

883  33  S=S+(XX(J)-SM)**2 

884  S=2.*S/(IG00DP*0.86) 

885  C******* 

886  C*******  XM  -  MU,  SD  -  SIGMA.  THE  RAYLEIGH  WIDTH  PARAMETER  (SCALED  VAR) 

887  C******* 

888  XM=SM-SQRT(S*1.5708) 

889  SD=SqRT(S) 

890  C******* 

891  C*******  LIMIT  THE  RAIGE  OF  THE  DATA  USIIG  MU  A*n  THE  SD 

892  C*******  REDEFIIE  UPRLIM  AID  LOWLIM 

893  C******* 

894  LOWLIM=  XM 

895  UPRLIM  =  XM  +  4.0  *  SD 

896  DO  34  J=M,K 

897  IF  (XX(J)  .LT.  XM)  XX(J)  =  XM 

898  IF  (XX(J)  .GT.  UPRLIM)  XX(J)  =  UPRLIM 

899  34  COITIIUE 

900  C******* 

901  C*******  RECALCULATE  S  USIIG  THE  FIXED  UP  DATA 

902  C*******  SET  XMOD  EQUAL  TO  MU  +  SIGMA 

903  c******* 

904  S=0. 

905  DO  35  J=M,K 

906  35  S=S+(XX(J)-XM)**2 

907  S=S/(2.*IG00DP) 

908  SD=SQRT(S) 

909  XMOD=XM-t-SD 

910  RETURI 

911  c******* 

912  C*******  IF  EITIRE  SAMPLE  IS  THROWI  OUT  USE  XMOD  =  XX(I25) 

913  C*******  BASED  01  EMPIRICAL  EVIDEICE 

914  C******* 

915  40  IF(UCIT  .LE.  54)  GO  TO  41 

916  WRITE (KW, 302) 
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917 

918 

919 

920 

921 

922 

923 

924 

925 

926 

927 

928 

929 

930 

931 

932 

933 

934 
936 

936 

937 

938 

939 

940 

941 

942 

943 

944 
946 

946 

947 

948 

949 

960 

961 

962 

963 

964 
956 

966 

967 

968 

969 

960 

961 

962 

963 

964 
966 

966 

967 

968 

969 

970 


302  FORMATClMlX, 'Q' .IIX, 'SEQ  #M1X, 'XMOD'.IOX, 'XX(25) '  .9X. 

«  ’XX(75)') 

WRITE(KW,310) 

310  FORMAT(’  +  ’ ,6(5X,  ' _ ')/) 

UC1T=0 

41  XMOD  =  XX(125) 

WRITE (KW , 306 )  Q , LBLREC . XMOD . XX (I 25) . XX ( 175 ) 

306  F0RMAT(1X.F16.0.I15.3F16.4) 

UCIT=UCIT+1 

RETURI 

C******* 

c*******  all  courts  outside  the  BOURDS,  write  MESSAGE,  SET  FARMS. 
c******* 

46  CORTIRUE 

WRITE(KW,307)  ngoodp , LBLREC . XMOD 

307  FORMATC  RGOODP  =’.110,’  AT  SEQ  #  ’.110,’  XMOD  =  ’,F20.4) 

RF.TU»W 

c*******  ROT  erough  poirts  to  do  arythirg 
60  WRITE(KW,308)  RPTS 

308  FORMATClH  .’MISTAKE:  SHOULDRT  HAVE  RPTS= ’ , 14, ’ . LT. 8 ’ ) 

RETURR 

ERD 

c********************************************************»************ 

c******* 

SUBROUTIRE  YRDAY (lYR ,MRTH , IDAY , lYRDAY) 

C**««*«* 

c«*«*««*  COMPUTES  YEAR  DAYS  (  EXCEPT  OR  CERTURIES) 

C*«««*** 

DINERSIOR  ID(12) 

DATA  ID(1) ,ID(2) ,ID(3) .ID(4) ,ID(5) ,ID(6) ,ID(7) ,ID(8) ,ID(9) , ID(IO) , 
eiD(ll) ,ID(12)/1,32,60.91, 121, 152, 182, 213,244, 274,305.335/ 
IYRDAY=(ID(MRTH)-1)+IDAY 

IF ( (MOD ( lYR , 4) . EQ . 0) . ARD . (MRTH . GT . 2) )  IYRDAY=IYRDAY+ 1 

RETURR 

ERD 

C******* 

C'**************^******************************************** *********** 
c******* 

SUBROUTIRE  GMTYR  (IYRDAY,IHOUR,MIRUT,ISEC.GT, LOCAL. IT70R) 

C******* 

c*******  COMPUTES  GREEHVICH  HOURS  JR  YE.»R  SIRCE  TAR  01  0000  Z 
C*******  IR  DECIMAL  FORM  -  DOUBLE  PRECISIOR 

C******* 

c*******  LOCAL  =  0  TIME  ALREADY  IR  GREERWICH 

C««*«***  =  1  local  time  . . .  MUST  CORVERT  TO  GREERWICH  BY  ADDIRG  ITZOR 

C*******  ITZOR  IS  POSITIVE  FOR  WEST  LORGITUDE,  REGATIVE  FOR  EAST 
C*«*««**  E.G.  4  IS  REAR  BERMUDA 
C******* 

DOUBLE  PRECISIOR  GT 
TP  (LGCM.)  10,10,6 
5  IHOUR  =  IHOUR  +  ITZOR 


971  10  GT  =  DFL0AT((IYRDAY  -  1)  ♦  24  +  IHOUR)  +  DFL0AT(MIlUT)/60. 

972  «+  DFL0AT(ISEC)/3600. 

973  RETURI 

974  EID 

975  subroutine  bin«indo«(ibot , itop) 

976  c*******  added  7/16/89 

977  c******* 

978  c*******  This  routine  is  a  FORTRAI  variation  of  the  pascal  procedure 

979  c*******  "bins"  listed  in  Real  Tine  Processing  with  Inverted  Echo  Sounders 

980  c*******  by  Robert  Petrocelli. 

981  cveeeee* 

982  c*****e*  The  coding  has  been  simplified  and  adapted  for  use  eithin  the 

983  c*******  Nemode  code.  A  description  of  the  variables  used  follows ; 

984  c******* 

985  c*******  XX  array  containing  the  travel  time  counts 

986  c*******  bin  array  of  96  bins  representing  128  lount  interval  from 

987  c*******  0-8192*(l .5) .  The  factor  of  1.6  insures  that  BUISFIXed 

988  c*******  files  are  suitablly  processed. 

989  c*******  mar  used  to  store  the  maximum  number  of  occurrences  for  a  bin 

990  c*******  kmax  pointer  to  locate  max  in  the  array  bin.  Upon  completion 

991  c*******  of  the  routine  kmax  will  be  used  to  specify  a  range 

992  c*******  within  which  the  mode  is  moat  likely  to  be  found. 

993  c*******  ibot  index  of  the  first  travel  time  in  xx  to  be  used,  ibot 

994  c*******  and  itop  are  indices  found  by  applying  the  PUIS  window. 

996  c*******  Upon  exit  from  the  routine  ibot  and  itop  will  contain  the 

996  c*******  new  indices  for  the  useful  travel  times,  xx(ibot)  to 

997  c*******  xx(ltop) . 

998  c*******  itop  index  of  the  last  travel  time  to  be  used  by  this  routine 

999  c*******  toplim  new  upper  travel  time  limit 

1000  c*******  botlim  new  lower  travel  time  limit 

1001  c******* 

1002  c*******  See  Mr.  Petrocelli ’a  report  for  details.  In  short  this  routine 

1003  c*******  applies  a  window  to  refine  the  data  before  the  ttmode 

1004  c*******  routine.  The  idea  is  that  the  true  surface  reflections  will  bo  most 
1006  c*******  probable  returns  and  there  is  a  time  period  within  which  all  the  true 

1006  c*******  echo  would  be  expected  to  reside.  The  13  bit  range  of  8192  is 

1007  c*******  divided  into  64  intervals.  The  bin  containing  the  largest  number  of 

1008  c*******  occurances  is  also  most  likely  to  be  the  interval  within  which  the 

1009  c*******  single  travel  time  representative  of  the  burst  would  be  found. 

1010  c*******  To  insure  that  all  the  true  echos  are  encompassed  the  adjacent 

1011  c*******  intervals  are  included;  all  other  bins  eure  excluded  from  further 

1012  c*******  processing.  The  range  of  3(128)  counts  is  certainly  capable  of 

1013  c*******  enclosing  the  200  count  range  that  the  main  trace  on  a  "healthy" 

1014  c*******  buns  plot  fits  within. 

1016  c******* 

1016  integere4  bin(lOO) 

1017  integer  toplim, botlim 

1018  reale4  xx(lOO) 

1019  common/commod/xx 

1020  c  ommcn/memo  cm/ xmod , ngoodp , so , apt  s 

1021 

1022  c***e**e 

1023  c*******  don’t  bother  if  only  one  point 

1024  c******* 
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1025  i{  (ibot . eq. itop)  return 

1026  c******* 

1027  c*******  initialize  Bax  and  array  bin 

1028 

1029  ■ax=0  ~ 

1030  do  40  i=l,100 

1031  bin(i)=0 

1032  40  continue 

1033  c******* 

1034  c*******  loop  thru  and  increaent  the  number  occurances  vithin  a  particular 

1035  c*******  count*  interval.  Ezaaple:  II  ixz(i)=394  then  k=4  and  bind'  is 

1036  c*******  increased  by  one.  II  ixx(i)=128  then  k=l  and  bin(l)=bin(l)+l . 

1037  c*******  lote  that  the  first  t*r«  of  k  is  integer  division. 

1038 

1039  do  10  i=ibot,itop 

1040  k=(int(xx(i))-i)/128  +1 

1041  bin(k)=bin(k)+l 

1042  c******* 

1043  c*******  store  the  current  MaximuB  number  of  occurrances  and  its  location 

1044  c***’***^ 

1045  if  (bin(k) .gt .max)  then 

1046  aax=bin(k) 

1047  kBax=k 

1048  endif 

1049 

1050  10  continue 

1051  c****** 

1052  c*e«***  set  the  travel  time  limits 

1053  c*****e 

1054 

1065  toplim=(luiax-t-l)ei28 
1056  botliB=(kmax-2)*128 
1067  cee**** 

1058  c******  use  these  liaits  to  find  indices  of  fist  and  last  points  in  the 

1069  c******  new  window. 

1060  c****** 

1061  c******  claap  down  to  find  the  bottom  of  the  window. 

1062  c****** 

1063  do  20  i=ibot,itop 

1064  if  (xx(i) .ge.botlia)  then 

1065  ibot^i 

1066  goto  100 

1067  endif 

1068  20  continue 

1069  c****** 

1070  c******  do  the  similar  operation  to  find  the  top  of  the  window. 

1071  c****** 

1071 

1073  100  do  30  l=itop,ibot,-l 

1074  It  (xACi.)  .le.toplia)  then 
1076  itop=i 

1076  return 

1077  endif 

1078  30  continue 
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3.5  DETIDE-AUG90.FOR 


3  z%m.m. 

4  revised  from  detide_jul88.1or  to  deal  with  ♦.lill  files  from 

B  cy.y,y.'/,y,y.y.  fill_aug90.for.  These  differ  from  detide_jul88 . f or  in  that  they 
6  cy.%y,y.y.y.y,  contain  only  travel  time  and  yearhour  (  no  tmp,  prs,  or  am  col- 
cyxmn  umns). 

8  cy.y.y.y.y.y.x 

9  cy.y.y.y.y,y.y.  Fields  4-ang-90 

10  c******* 

11  c*******  DETIDE. J0LY88. FOR 

12  c******* 

13  ceeeeeee  PROGRAM  TO  DETIDE  THE  MEDIAI/MODE  VALUES  OF  TRAVEL  TIMES. 

14  ceeeee**  DETERMIIES  THE  TIDAL  HEIGHT  II  CM  AID  COIVERTS  IT  TO  SECOIDS. 

15  c*******  IT  IS  ASSUMED  THAT  THE  DATASET  HAS  BEEI  PROCESSED  THROUGH  THE 

16  C*******  FILL  PROGRAM.  SO  THAT  THERE  ARE  10  GAPS.  THE  OUTPUT  DATASET 

17  C*******  COITAIIS,  THE  MEASURED  TAU'S,  THE  DETIDED  TAU’S  AID  THE  TIDE. 

18  c*******  AS  WELL  AS  THE  OTHER  IIPUT  PARAMETERS. 

19  c******* 

20  C*******  FORTRAI  UIIT  lUMBERS  DESIGIATED  AS  FOLLOWS: 

21  c*******  KR  (UIIT  15)  COITROL  CARD  IIPUT  FILE 

22  C*******  KRl  (UIIT  18)  IIPUT  DATASET  FROM  FILL 

23  ce*e****  KW  (UIIT  11)  OUTPUT  USERS  LOG 

24  c*******  KWl  (UIIT  17)  OUTPUT  DATA  FILE 

25  c******* 

26  IITEGER*4  YEAR . TOTREC . HUIDRD , RECOUT 

27  CHARACTERseO  HEADR 

28  CHARACTERelO  LOCI 

29  REAL*4  TIME(200) .DELT 

30  REALM  TTB(200).Z0,MTIDCM.TTID(200) 

31  REAL*4  X0DTID(200) 

32  REALMS  DTIME 

33  c******* 

34  COMMOI/TIDCOI/  H(8),  PHI(8) ,VU(8) .FI0DE(8) 

36  COMMOI/TPARMS/ZO.IYR.ICALVU 

36  C******* 

37  PARAMETER  (HUIDRD=200) 

38  PARAMETER  (KR=16.KW=11 .KW1=17.KR1=18) 

39  lAMELIST/CAROl/HEADR 

40  IAMELIST/CARD2/IFIRST . ILAST . lYR . DELT 

41  IAMELIST/CAR03/H 

42  IAMELIST/CAR04/PHI 

43  lAMELIST/CARDB/FIODE 

44  IAMELIST/CARD6/VU 

46  IAMELIST/CARD7/CBAR.PFACTR,L0CI 

46  DATA  ICALVU/0/ 

47  DATA  CBAR/1610./.PFACTR/1.0/,LDCI/’I.U. '/ 

48  DATA  MTIDCM/0.0/.TTID/200*0.0/ 

49  DATA  ZO/0.0/ 

60  DATA  H/8*0.0/,PHI/8*0.0/,FIODE/8*1.0/,VU/8*0.0/ 

61  DATA  RECOUT/O/.IPRIT/O/ 

62  C***** 


53  C*****  OPEI  I/O  UIITS  AID  FILES 

54 

55  OPEI (UIIT=KR.STATUS=’ OLD • .FORM=* FORMATTED' .READOILY) 

56  OPEI ( UI IT=KR 1 , STATUS= ’ OLD ' , FORM= ' FORMATTED ’ . READOILY ) 

57  OPEI ( UIIT=KW . STATUS= ' lEW ' . FORM= ' FORMATTED ' ) 

58  OPEI(UIIT=KWl.STATUS=’IEW' . FORM= ’ FORMATTED ’ ) 

59  c****** 

60  READ  COITROL  PARAMETERS 

61  C******  IFIRST:  THE  REC  #  OF  THE  FIRST  'GOOD'  RECORD 

62  C******  ILAST:  LAST  REC  #  TO  BE  PROCESSED 

63  C****** 

64  READ(KR,IML=CARD1} 

65  READ(KR,IML=CARD2) 

66  READ(KR,INL=CARD3) 

67  READ(KR.IML=CAR04) 

68  READ (KR,IML=C ARDS) 

69  READ(KR,IML=CARD6) 

70  READ(KR.IML=CARD7) 

71  C***** 

72  WRITE (*,42) 

73  42  F0RMAT(1X.//.6X, '  DETIDE  IS  lOW  PROCESSIIG  YOUR  DATA!!'//) 

74  c******* 

75  C*******  PRUT  COITROL  PARAMETERS 

76  C******* 

77  WRITE(KW,400) 

78  400  FORMAT(1H1,T50, '*  *  *  ’ROGRAM  DETIDE  *♦*',//) 

79  WRITE(KW,406)  HEADR 

80  405  FORMAT (/T36,A60) 

81  WRITE(KW.410)  IFIRST, ILAST, CBAR.PFACTR, LOCI 

82  410  F0RMAT(//T15, 'IFIRST', T26, 'ILAST', T37, 

83  I'CBAR' ,T45, 'PFACTR' ,TS7, 'LOCI' , 

84  «/,'  +  ', Til, 6(2X,' _ '), 

85  e//,T10,2I10,2F10.2,6X,A4) 

86  WRITE(KW,416)  IYR,DELT 

87  416  F0RMAT(//8X,'IYR  =',I10//8X,'DELT=',F12.7) 

88  WRITE(KW,420)H,PHI,VU,FI0DE 

89  420  F0RMAT(//T10, 'TIDAL  PARAMETERS  ', 

90  0//T17, 'M2' ,T27, '12' ,T37, 'S2' ,T47, 'K2' ,T57, 

91  •'Kl' ,T67, '01' ,T77, 'PI' ,T87, 'Ql' , 

92  e//TW, 'H' ,8F10.2, 

93  C/T7, 'PHI' ,8F10.2, 

94  «/T6,'V0+U',8F10.3, 

96  «/T9, 'F' ,8F10.3//) 

96  WRITE(KV,42S) 

97  425  FORMAT (//T40, 'FIRST  RECORD  OF  EACH  BLOCK  PROCESSED', 

98  C/ZT 1 6 , ' TTB ' , T26 , ' XODTID ' , T37 , ' TTID ' , T48 , ' TIME ' , 

99  •/,  '+',T12,2X, ' _ '  ,3(3x, ' _ ’),//) 

100  c******* 

101  C*******  COMPUTE  TRAVEL  TIME  COIVERSIOI  FACTOR,  TTCOIV  COIVERTS  TIDE 

102  C*******  FROM  CM  TO  SEC.  CBAR  II  (M/SEC)  IS  AVERAGE  SOUID  VELOCITY 

103  C***««**  FROM  MATTHEWS  TABLES  FOR  THE  LOCATIOI  AID  DEPTH  OF  THE  lES. 

104  c****«*«  PFACTR  =  1  +  DEPTH  *  l.lE-6,  WHERE  1 . lE-6=( 1/C) (DC/DP) 

106  C*******  DEFAULT  FOR  PFACTR  IS  1.0 

106  C******* 
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107  TTCOfV  =  2.0E-2  /  (CBAR  ♦  PFACTR) 

108  c******* 

109  C*******  READ  DATA  II  BLOCKS  OF  200  TO  IMPROVE  I/O  EFIICIEICY. 

110  c******* 

111  c******* 

112  C*******  COMPUTE  TOTAL  #  OF  RECORDS  TO  BE  READ,  AID  THE 

113  C*******  CORRESPOIDIIG  lUMBER  OF  BLOCKS,  PLUS  A  REMAIIDER. 

114  C******* 

116  25  COITIIUE 

116  TOTREC  =  ILAST-IFIRST  +  1 

117  IBLK  =  TOTREC/HUIDRD 

118  IGET  =  KOD(  TOTREC  ,  HUIDRD  ) 

119  IF(  IBLK  .LT.  1)  IGET  =  TOTREC 

120  IGO  =  HUIDRD 

121  IRDBLK  =  0 

122  c******* 

123  C*******  READ  BLOCK  OF  DATA.  CHECKIIG  THAT  THERE  ARE  AT  LEAST  200 

124  C******* 

125  30  IFdRDBLK  .GE.  IBLK)  IGO  =  IGET 

126  IF(IGO  -EQ.  0)  GO  TO  55 

127  READ (KRl, 430, EID=999)  (TTB(I) .TIME(I) ,1=1 ,IGO) 

128  430  F0RMAT(2E16.7) 

129  IRDBLK  =  IRDBLK  >  1 

130  C******* 

131  C*******  PROCESS  OIE  BLOCK  OF  DATA  AT  A  TIME 

132  C******* 

133  DO  46  J=l,IGa 

134  C******* 

136  C*******  COIVERT  TIME  TO  DOUBLE  PRECISIOI 

136  c****««* 

137  40  COITIIUE 

138  DTIME  =  DBLE(TIME(J)) 

139  C******* 

140  C*******  lOH  COMPUTE  TIDAL  HEIGHT 

141  C******* 

142  CALL  TIDE(DTIME.MTIDCM) 

143  C******* 

144  C*******  ALL  TRAVEL  TIMES  ARE  II  SECOIDS,  SO  SCALE  TIDE  TO  SECOIDS  AID 

146  C*******  SUBTRACT  FROM  THE  IIPUT  DATA 

146  C******* 

147  TTID(J)  =  (TTCOIV  •  MTIDCM) 

148  XODTID(J)  =  TTB(J)  -  TTID(J) 

149  46  corrziuE 

150  C******* 

161  C*******  PRUT  FIRST  RECORD  OF  EACH  BLOCK  TO  OUTPUT  LOG 

162  C******* 

163  WRITE  (KW.436)  TTB(l) ,X0DTID(1) .TTID(l) ,TIME(1) 

164  436  F0RMAT(/T10,F11.6.1X.2F11.6.F10.2) 

166  IPRIT  =  IPRIT  +  1 

166  C******* 

167  C*******  DUMP  IT  ALL  01  THE  DISK  OUTPUT 

168  C^****** 

169  WRITE(KW1,440)  (TTB(J) ,XODTID(J) .TTID(J) .TIME( J) . J=1 ,IGO) 

160  440  F0RNAT(4E16.7) 
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181  RECOUT  =  RECOUT  +  ICO 

162  BO  IFdGET  .LT.  IGO)  GO  TO  30 

163  C******* 

164  C*******  EID  OF  PROCESSIIG  -  WRAP  UP 

165  c******* 

166  56  COITIIUE 

167  WRITE(KW,460)  RECOUT 

168  460  FORMAT  (//T 10.  ’  **♦  PROCESSIIG  EIDED  AT  SPECIFIED  RECORD—’, 

169  •16.'  RECORDS  WRITTEI  01  UIIT  12’//) 

170  WRITE(*,460)  RECOUT 

171  WRITE(*.43) 

172  STOP 

173  999  WRITE(KW.466)  RECOUT, I 

174  455  F0RMAT(//T10, ’»»  ERROR:  UIEXPECTED  EID  OF  DATA  ««’, 

176  C/TIO.IS,’  RECORDS  PROCESSED’ .16, ’  ADDITIOIAL  RECORDS’ , 

176  «’  READ  BEFORE  EOF’//) 

177  C***** 

178  WRITE(*,465)  RECOUT, I 

179  tfRITE(*.43) 

180  43  F0RMAT(6X. ’  FIIISHED! ! ’//) 

181  STOP 

182  EID 

183  c******* 

184  C*******************************************************^************* 

186  C******* 

186  SUBROUTIIE  TIDE(GYRHR.2T) 

187  C******* 

188  C*******  TIDAL  COMPOIEITS  ORDERED:  M2,  12,  S2.  K2,  Kl,  01.  PI,  Q1 

189  C*******  REQUIRES  HALF  AMPLITUDES:  H(L) ,  CM 

190  C*******  PHASES:  PHI(L)  DEGREES,  GREEIWICH  EPOCH 

191  C**«««**  GYRHR  =  GREEIVICH  HOURS  SIICE  THE  BEGIIIIIG  OF  lYEAR 

192  C*******  VOAIDU  IS  THE  ARGUMEIT  OF  EQUILIBRIUM  TIDE  (GEOPOTEITIAL) 

193  C*******  AT  THE  STARTIIG  TIME  AT  GREEIWICH  MERIDIAI  (VO  +  U 

194  C*******  II  TABLE  16  OF  COAST  AID  GEODETIC  SURVEY  SPECIAL  PUB.  98). 

196  C******* 

196  C******* 

197  c****«*«  METHOD;  ZT  =  20  +  SUM  (H(L)  •  COS(ARG(L)) 

198  C*******  WHERE: 

199  C*******  ARG(L)  =  TPI  *  (FREQ(L)  ♦  TIME  ♦  (VU(L)  -  PHI(L))  /  360.0) 

200  c******* 

201  C***«***  VU(L)  IS  THE  ARGUMEIT  (DEGREES)  OF  EQUILIBRIUM  TIDAL 

202  C*******  COISTITUEIT  L  AT  REFEREICE  TIME  =  IDAYS 

203  c******* 

204  C*******  ZT  IS  THE  CALCULATED  TIDE 

205  C******* 

206  C*******  lOTE:  GIVES  CAREFUL  ATTEITIOI  TO  USIIG  DOUBLE  PRECISIOI 

207  C*******  OILY  WHERE  lECESSARY 

208  c******* 

209  COMMOI/TIDCOI/  H(8) .PHI(8) ,VU(8) .FI0DE(8) 

210  COMMOI/TPARMS/ZO,IYEAR,ICALVU 

211  REAL*4  V0AIDU(8),PCYCLS(8) 

212  IITEGER«4  CALLCT 

213  DOUBLE  PRECISIOI  FREQ (8) .GYRHR, DAYS, FLOAT. DCYCLS 

214  PARAMETER  (TPI=6. 2831863, KW=1) 
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215 

216 

217 

218 

219 

220 
221 
222 

223 

224 

225 

226 

227 

228 

229 

230 

231 

232 

233 

234 

235 

236 

237 

238 

239 

240 

241 

242 

243 

244 

245 

246 

247 

248 

249 

250 

251 

252 

253 

254 

255 

256 

257 

258 

259 

260 
261 
262 

263 

264 
266 
266 

267 

268 


DATA  CALLCT/0/ 

DATA  FREQ(1)/1.9322736D0/, 

«  FREq(2)/1.8969820D0/. 

4  FREQ(3)/2.0D0/, 

6  ■PREQ(4)/2.0054758D0/. 

fl  FREQ(6)/1.0027379D0/, 

C  FREQ(6)/0.9295357D0/. 

6  FREQ (7) /O. 997262 IDO/, 

C  FREq(8)/0.8932441D0/ 

DATA  VOAIDU/8. 3. 66. 7, 0.0, 217. 6, 18. 9. 346. 2, 349. 8. 42. 6/ 

C«*****« 

c***«**«  COUIT  lUMBER  TIMES  THIS  SUBROUTIIE  HAS  BEEI  CALLED. 

C*******  CHECK  TO  SEE  IF  VU  MUST  BE  CALUCLATED  (ICALVU=1) 

C*«*4i***  OR  IF  IT  HAS  SUPPLIED  (ICALVU=0). 

CALLCT=CALLCT+1 

IF  (ICALVU  .Eq.  0)  GO  TO  25 

c*******  VU  MUST  BE  CALCULATED: 

C*««*«**  CALCULATE  «  OF  DAYS  FROM  1  JAl  1900  TO  1  JAI  lYEAR 
C*««***«  leap  days  01  YEARS  DIVISIBLE  BY  4  EXCEPT  1900 

C*******  (CEITJRY  lOT  LEAP  YR  UILESS  DIVISIBLE  BY  400). 

CALCULATE  «  OF  CYCLES  PER  DAY  AT  EACH  FREqUEICY, 

C*******  USE  OILY  FRACTIOIAL  lUMBER  OF  CYCLES. 

10  LPDYS  =  (lYEAR  -  1900)  /  4 

IDAYS  =  (lYEAR  -  1900)  ♦  366  +  LPDYS 

DO  16  L  =  1,  8 

DCYCLS  =  FREq(L)  *  IDAYS 

DCYCLS  =  DCYCLS  -  FLOAT(IDIIT(DCYCLS)) 

VU(L)  =  SIGL(DCYCLS)  •  360.0  +  VOAIDU(L) 

IF  (VU(L)  .GE.  360.)  VU(L)  =  VU(L)  -  360. 

15  COITIIUE 
ICALVU  =  0 

WRITE(KW,400)  lYEAR, (VU(L) ,L=1 ,8) 

400  F0RMAT(//1H0, 'EqUILIBRIUM  TIDE  ARGUMEITS  (DEGREES) 

«’  AT  THE  BECIIIIIG  OF  ’ ,I4,8F8. 1//1H0) 

VU  ALREADY  CALCULATED: 

C*«***4>*  IF  FIRST  CALL  TO  SUBROUTIIE.  CALCULATE  THE  DIFFEREICES 
C*******  BETVEEI  THE  PHASES  VU  AID  PHI.  THEI  COIVERT  TO  CYCLES/DAY. 

C««««*** 

26  COITIIUE 

IF  (CALLCT  .GT.  1)  GO  TO  36 
DO  30  L=l,8 

PCYCLS(L)  =  (VU(L)  -  PHKD)  /  360.0 
30  COITIIUE 

c*******  MAII  LOOP  FOR  CALCULATIIG  THE  TIDE  AT  TIME=GYRHR 
C**«*««* 

35  COITIIUE 

DAYS  =  GYRHR  /  24.0D0 
ZT  =  ZO 
DO  40  L=l,  8 


DCYCLS  =  FREq(L)  ♦  DAYS 

DCYCLS  =  DCYCLS  -  FLOAT(IDIIT(DCYCLS) ) 

ARGL  =  (S*GL(DCYCLS)  +  PCYCLS(L))  ♦  TPI 

ZT  =  ZT  +  FIODE(L)  *  H(L)  ♦  COS(ARGL) 

COITIIUE 

RETURI 

EID 
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3.6  DESPIKEJVUG90.FOR 


1 

2 

3 

4 

5 

6 

7 

8 
9 

10 

11 

12 

13 

14 
16 
16 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 
61 
52 


cyx/x/.y.my.ny.y.y.my.y.my.y;/.y.y.y.yx/.y.%y/m 

cyX/.y.y.y.y.  d«spike_aug90  .lor 

cy.y.y.y.y.y.x  - 

differs  from  despike. jul88. for  in  logical  unit  numbers 
c'/X/X/X/.  and  the  number  of  columns  in  the  input  file.  This  version 
cyX/X/.y.y.  is  applied  to  a  four  column  travel  time  input  file. 

cy.y.y.y.y.y.y.y.y.y.y.y.y.y.y.xy.y.y.y;/.y.y.y;/.y.y.y.yx/.y.yx/x/.y.y.y.y.y.xxy.%y.y////.y.^ 

DESPIKE. JULY88. FOR 


C* 

C* 

C* 

C* 

C* 

C* 

C* 

C* 

C* 

C* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 

c* 


PROGRAM  TO  DESPIKE  THE  DETIDED  TRAVEL  TIMES.  SPIKES  ARE 
IDEITIFIED  II  TWO  WAYS:  1)  THE  DATA  MUST  BE  WITHII  A  SPECIFIED 
RAIGE  OF  GOOD  TRAVEL  TIMES;  AID  2)  THE  CHAIGE  BETWEEI  TWO 
ADJACEIT  MEASURENEITS  MUST  BE  LESS  THAI  A  SPECIFIED  RATE.  IF 
EITHER  OF  THESE  TWO  CRITRIA  IS  lOT  MET.  THE  DATA  POUT  IS 
REPLACED  WITH  Al  IITERPOLATED  VALUE. 

PROGRAM  ORIGIIALLY  WRITTEI  BY  BY  J.  GUII  1978, 

BUT  HAS  BEEI  REWRITTEI  SEVERAL  TIMES  SIICE  1981  BY  K.  TRACEY. 
COIVERTED  TO  VAX  BY  SLW 

lOTE,  THE  SAV...  ARRAYS  MUST  BE  DIMEISIOIED  THE  SAME  AS  OR 
GREATER  THAI  MAXBAD. 

I/O  UIITS: 

KR  (UIIT  17)  COITROL  CARD  FILE 

KRl  (UIIT  19)  IIPUT  DATASET  FROM  DETIDE 

KW  (UIIT  11)  OUTPUT  USERS  LOG 

KWl  (UIIT  18)  OUTPUT  DATASET 

KW2  (UIIT  16)  OUTPUT  LISTIIGS  FILE 


IITEGER«4  IRECCT,  BADREC,  IBADCT,  IBAD 

IITEGER*4  FLAGCT 

LOGICAL  FLAG 

CHARACTER*80  HEADR 

IITEGER«4  MAXBAD 

REALe4  KITl 

REAL*4  SAVXO(IOO),  SAVXOD(IOO) , IIBTVI 
REAL«4  XO, TIME, TIDE 
REAL«4  XOFIL,  XODFIL 
REAL*4  SAVTID(100),SAVTIM(100),KIT1S 
R£AL«8  X1SAV(100),X0DIF.X0MAX 
REALe8  RIAVGl,  SMAXl 

PARAMETER  (KR1=19.  KW=11,  KW1=18,  KR=17,  KW2=16) 
PARAMETER  (01= '<===' .OFF='  ') 
lAMELIST/CARDl 'HEADR 
IAMELIST/CARD2/TIITVL , VMAX , VMII 
IAMELIST/CARD3/SL0PE1 .RIAVGl .LAVGl 
DATA  IRECCT/0/,  LIIECT/66/ 

DATA  IBADCT/0/,  IBAD/0/,  FLAGCT/O/,  MAXBAD/100/ 

C*e*** 

OPEI  I/O  UIITS  AID  FILES 


53 

54 

55 

56 

57 

58 

59 

60 
61 
62 
83 

64 

65 

66 

67 

68 

69 

70 

71 

72 

73 

74 

75 

76 

77 

78 

79 

80 
81 
82 

83 

84 

85 

86 

87 

88 

89 

90 

91 

92 

93 

94 

95 

96 

97 

98 

99 
100 
101 
102 

103 

104 

105 

106 


OPEl (U1IT=KR . STATUS= ’ OLD ' , FORM= ' FORMATTED ’ , READOCLV) 
0PEI(UIIT=KR1 .STATUS=‘GU)' .FORM='rORMATTED' .READOILY) 

OPEI (UIIT=KW . STATUS= ’ lEW ' , FORM= ’ FORMATTED ’ ) 

OPEI ( UIIT=KW1 , STATUS= • lEW ’ , FORM= ' FORMATTED ’ ) 

OPEI (UIIT=KW2 . STATUS=  * lEW ' . FORM= ' FORMATTED ’ ) 

C***** 

C*****  READ  AID  WRITE  II  THE  COITROL  CARDS 

C***** 

READ(KR,IML=CARD1) 

READ(KR,IML=CARD2) 

READ(KR,IML=CARD3) 

writ«(*,42) 

42  forBat(lx,//,5x, 'DESPIXIIG  your  data  sat - >  Pondaring  ’,/) 

WRITE (KV. 608)  HEADR 

608  F0RMAT(//4EX.  * . DESPIKE  . 

€/’0‘ .A80) 

WRITE(KW.610)  TIITVL,  VMAX,  VMII, 
eSLOPEl,  RIAVGl,  LAVGl 
610  F0RMAT(//6X, 'COITROL  CARDS’. 

•T26.9X,  ’TIITVL’  .nX.  ’VMAX’  .IIX,  ’VMII’/ 

•T26.3(6X,F10.4)// 

6T26 , 9X , ’ SLOPE 1 ’ . 9X . ’ RIA VG 1 ’ , lOX , ’ LAVG 1 ’ / 

•T25,2(SX,F10.4) .5X,I10//) 

c*******  IIITIALIZE  VARIABLES 

KITI  aid  KITIS  ARE  IIDEXES  OF  THE  XISAV  ARRAY 
Caaa***a  LASTl  IS  PREVIOUS  VALUE  OF  KITI 
C*«a«**«  RLAVGl  IS  lUMBER  OF  POUTS  II  RUIIIIIG  AVERAGE 
C**««*«*  SMAXl  IS  MAXIMUM  ALLOWED  CHARGE  II  SECOIDS  PER  SAMPLIIG  PERIOD 
C******* 

KITI  =  (LAVGl  +  1.0)/2.0 
KITIS  =  KITI 
LASTl  =  LAVGl 
RLAVGl  =  LAVGl 
SMAXl  =  SLOPE 1*TIITVL 
C******* 

C**a***a  IF  THE  IIITIAL  RUIIIIG  AVERAGES  WERE  lOT  SUPPLIED, 

C*******  COMPUTE  THEM  FROM  THE  FIRST  LAVGl  POUTS  II  THE  DATA  SET 
C***a*«a  lOTE  THAT  THESE  POUTS  WILL  lOT  BE  DESPIKED. 

C**«*aa* 

IF  (RIAVGl  .IE.  0.0)  GO  TO  30 
DO  20  I»l, LAVGl 

READ (KRl . 400 . EID-000 ) XO . XODTID . TIDE . TIME 

IRECCT  =  IRECCT  +  1 

WRITE ( KW 1 , 400 )  XO , XODTID , TIDE , TIME 

XISAV(I)  =  XODTID  /  RLAVGl 

RIAVGl  =  RIAVGl  *  XISAV(I) 

20  COITIIUE 
GO  TO  100 
C«*a«**a 

C«**«aa*  IF  IIITIAL  RUIIIIG  AVERAGES  WERE  SUPPLIED, 

C*a*«**«  IIITIALIZE  THE  PREVIOUS  POUTS  ARRAY  TO  THE  RUIIIIG  AVERAGES 
C**«a**« 
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107  30  COITIIUE 

108  DO  40  I=1,LAVG1 

109  XISAV(I)  =  RIAVGl  /  RLAVGl 

110  40  COITIIUE 

111  C******* 

112  C*******  MAII  PROCESSIIG  LOOP 

113  C*******  REMOVE  THE  SPIKES  FROM  THE  DATA 

114  C******* 

116  100  COITIIUE 

116  READ  (KR1,400.EID=900)  XO.XODTID. TIDE. TIME 

117  400  F0RMAT(4E16.7) 

118  IRECCT  =  IRECCT  +  1 

119  C******* 

120  C*******  TEST  EACH  DETIDED  POUT 

121  C*******  SEE  IF  IT  IS  OUTSIDE  THE  LIMITS  BEFORE  CHECKIIG  THE  SLOPE 

122  C******* 

123  IF  (XODTID  .GE.  VMAX)  GO  TO  106 

124  IF  (XODTID  .LE.  VMII)  GO  TO  106 

126  XODIF  =  XODTID  -  RIAVGl 

126  XOMAX  =  KITIS  *  SMAXl 

127  IF  (DABS(XODIF)  .GT.  XOMAX)  GO  TO  106 

128  GO  TO  110 

129  C******* 

130  C*******  FOR  BAD  POUTS,  OPEI  UP  THE  WIIDOW  AID  SAVE  THE  VALUES. 

131  C*******  TO  BE  WRITTEI  OUT  LATED  WITH  THE  IITERPOLATED  VALUES. 

132  C******* 

133  105  COITIIUE 

134  KITIS  =  KITIS  +1.0 

136  IBAD  »  IBAD  +  1 

136  IF  (IBAD  .EQ.  1)  BADREC  *  IRECCT 

137  IF  (IBAD  .GT.  MAXBAD)  GO  TO  2000 

138  SAVXO  (IBAD)  =  XO 

139  SAVXODdBAD)  =  XODTID 

140  SAVTID(IBAD)  =  TIDE 

141  SAVTIM(IBAD)  =  TIME 

142  CO  TO  100 

143  C+++++++ 

144  C*******  IF  THE  POUT  WAS  O.K.,  THEI 

146  C*******  RESET  THE  WIIDOV,  ACCOUITIIG  FOR  LEIGTHEIIIG  IF  FILLED 

146  C******* 

147  110  COITIIUE 

148  KITIS  -  KITl  +  IBA0/2.0 

149  C******* 

160  C*******  IF  PREVIOUS  POIIT(S)  WERE  GOOD  -  SKIP  THIS  LOOP 

161  C*******  IF  lECESSARY,  WRITE  A  lEW  HEADER  FOR  THE  LOG  PAGE 

162  C*++*++* 

163  IP  (IBAD  .EQ.  0)  GO  TO  116 

164  IF(LIIECT  .LE.  64)  GO  TO  77 

166  WRITE(KW2,72) 

166  72  F0RMAT(’l',7X,'RIAVG’,8X,'IBAD'.8X.'RECt*,8X.’X0LD’,7X, 

167  • ' XOFIL ' , 4X , • XDTIDOLD ' . 4X , ' XDTIDFIL ' . 8X , ’ TTID ’.1 OX . ’ TIME ' , 

168  •/•  +  *, 9(’  _ ’),’__’) 

169  LlIECT  =  0 

160  77  WRITE(KW2,632)  RIAVGl.  IBAD 


161  632  F0RMAT(/3X,F10. 6. 21,110) 

162  PRVXOD  =  XlSAV(LASTl)  •  RLAVGl 

163  DLTXOD  =  XODTID  -  PRVXOD 

164  XODIIC  =  DLTXOD  /  (IBAD  +  1) 

165  C*******  ~ 

166  C*******  IITERPOLATIIG  LOOP 

167  C*******  FILL  II  THE  BAD  POUTS  WITH  IITERPOLATED  POUTS 

168  C******* 

169  DO  114  I  =  1,  IBAD 

170  c******* 

171  c*******  IF  VALUE  OF  BAD  POUT  IS  BETWEEI  TWO  GOOD  DIES  -  SET  FLAG 

172  C******* 

173  FLAG  =  OFF 

174  IIBTWI  =  (XODTID  -  SAVXOD(I))  ♦  (SAVXOD(I)  -  PRVXOD) 

176  IFdIBTWI  .LE.  0.0)  GO  TO  112 

176  113  FLAG  =  01 

177  FLAGCT  =  FLAGCT  +  1 

178  c******* 

179  C*******  . UPDATE  THE  FIFO  RUIAVG  STACK  WITH  FLAGGED  POUTS  _ 

180  c******* 

181  LASTl  =  LASTl  +  1 

182  IF  (LASTl  .GT.  LAVGl)  LASTl  =  1 

183  RIAVGl  =  RIAVGl  -  XlSAV(LASTl) 

184  XIOW  =  DBLE(SAVXOD(I))  /  RLAVGl 

185  RIAVGl  =  RIAVGl  XIOW 

186  XlSAV(LASTl)  =  XIOW 

187  C******* 

188  C*******  _ EID  OF  UPDATIIG  FIFO  STACK  WITH  IITERPOLATED  DATA _ 

189  c******* 

190  112  COITIIUE 

191  XODFIL  =  PRVXOD  +  XODIIC  •  I 

192  XOFIL  =  XODFIL  +  SAVTID(I) 

193  C^**^*** 

194  c*******  WRITE  IITERPOLATED  POUTS  TO  OUTPUT  LOG  AID  DATASET 

195  C******* 

196  IF(I  .GT.  1)  GO  TO  78 

197  WRITE (KW2, 634)  BADREC,  SAVXO(I).  XOFIL. 

198  •SAVxOD(I),  XODFIL.  SAVTID(I).  SAVTIM(I) .FLAG 

199  634  F0RMAT('+',26X,I10,6(2X,F10.6),2X.F12.5,2X.A4) 

200  LIIECT  =  LIIECT  +  2 

201  GO  TO  79 

202  78  WRITE(KV2,636)  BADREC.  SAVXO(I),  XOFIL. 

203  «SAVXOD(I),  XODFIL,  SAVTID(I),  SAVTIM(I) .FLAG 

204  636  FORMAT('  ’ ,26X,I10,6(2X,F10.6) ,2X.F12.6,2X.A4) 

206  LIIECT  =  LIIECT  +  1 

206  79  WRITE(KW1,400)  XOFIL,  XODFIL,  SAVTID(I).  SAVTIM(I) 

207  BADREC  »  BADREC  *  1 

208  114  COITIIUE 

209  C******* 

210  C*******  IICREMEIT  THE  COUITERS 

211  c******* 

212  IBADCT  =  IBADCT  *  IBAD 

213  IBAD  =  0 

214  116  COITIIUE 
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216  C******* 

216  C*******  SAVE  THE  LAST  LIGAVG  POUTS  II  A  FIFO  STACK 

217  C«*****«  AID  UPDATE  THE  RUIIIIG  AVERAGES 

218  C*******  lOTE:  THE  STACK  COITAIiS  THE  VALUE  OF  EACH  POUT  DIVIDED  BY 

219  C*******  ThI  HUMBER  OF  POUTS  II  THE  RUIIIIG  AVERAGE 

220  C*******  THIS  WAY  WE  OILY  HAVE  TO  DIVIDE  OICE  PER  POUT 

221  C******* 

222  LASTl  =  LASTl  +  1 

223  IF  (LASTl  .GT.  LAVGl)  LASTl  =  1 

224  RIAVGl  =  RIAVGl  -  XlSAV(LASTl) 

226  XlSAV(LASTl)  =  DBLE(XODTID)  /  RLAVGl 

226  RIAVGl  =  RIAVGl  *  XlSAV(LASTl) 

227  C******* 

228  C*******  WRITE  THE  GOOD  POUTS  TO  THE  OUTPUT  DATA  SET 

229  C*******  THEI  COITIIUE  TH  PROCESSIIG  LOOP 

230  C******* 

231  WRITE (KW 1,400)  XO.XODTID, TIDE, TIME 

232  GO  TO  100 

233  c******* 

234  C***^***  IF  TOO  MAIY  COISECUTIVE  BAD  RECORDS  - 

236  C*******  PRUT  MESSAGE  AID  STOP 

236  c******* 

237  2000  COITIIUE 

238  WRITE(KW,680)  MAXBAD 

239  680  F0RMAT(//6X,'M0RE  THAIM4,'  COISECUTIVE  BAD  POUTS  FOUID', 

240  •//BX, '♦•••♦  RUI  TERMIIATED  ♦****') 

241  WRITE(«,680)  MAXBAD 

242  STOP  999 

243  c******* 

244  C*******  WRAP  UP  -  WRITE  IIFO  TO  OUTPUT  LOG 

245  c******* 

246  900  COITIIUE 

247  WRITE(KW,690)  IRECCT,  IBADCT,  FLAGCT 

248  690  F0RMAT(//6X,I6,'  RECORDS  WERE  PROCESSED', 

249  €//6X,I6,'  BAD  POUTS  WERE  REPLACED’, 

260  «//5X,I6,’  REPLACEMEITS  WERE  FLAGGED') 

261  writ«(*,43) 

262  43  formate lz,//,6x, 'Pondering  Finished! ’) 

263  STOP 

264  BID 
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3.7  SEACOR_AUG90.FOR 


3  cvfxmt 

4  c*/,*/,‘/,'/,V,‘/,X  r«vis«d  in  accordanc«  vith  th«  aug90  changas  in  the 

5  c'/’/'/'/'/'/X  processing  tree.  Seacor_aug90  is  applied  to  a  file 

6  c'/,'/,'/.'/.'/,V,X  sithout  tenp,  press,  and  aab  colusms 

7  c'/x/xm 

8  c . . . . . 

9  c . ">•••"•  23-Iov-1990  revised  to  include  the  ne«  seasonal 

10  c‘" .  corrections  for  uy  Stephen,  Karen,  and  DRW.  The 

11  c . .  correction  factors  used  are  location  specific. 

12  c . .  There  are  three  regions.  The  SYIOP  data  falls  into  two 

13  c . .  of  the  regions;  The  inlet  array  is  region  1,  and  the 

14  c .  central  array  is  in  region  2. 

15  c . . 

16  c . .  The  control  file  nos  requires  a  third  namelist  containing 

17  c ”•••••••••"•  th,  numerical  specification  of  the  region  (1  or  2). 

18  c . . . 

19  Cveeeeve 

20  C*******  SEACQR. JULY88.F0R 

21  C******* 

22  C*******  A  SEASOIAL  CORRECTIOI  FACTOR  IS  ADDED  TO  THE  MEASURED  AID 

23  c****v**  DETIDED  TRAVEL  TIMES.  THE  CORRCTIOI  FACTOR  FOR  EACH 

24  c*******  SAMPLIIG  PERIOD  IS  CALCULATED  BY  A  LIIEAR  lITERPOLATIOi 

25  C*******  BETWEEI  THE  ARRAY  OF  MOITHLY  CORRECTIOI  FACTORS  (CF) . 

26  C******* 

27  C*******  FOR  THIS  VERSIOI,  THE  VALUES  II  ARRAY  CF  ARE  FOR  THE  GULF 

28  C*******  STREAM  REGIOI.  THEY  WERE  CALCULATED  USIIG  ISELII'S  (1940) 

29  C*******  HYDROGRAPHIC  DATA. 

30  C******* 

31  c*******  I/O  UIITS: 

32  c*******  KRCTRL  (UIIT  1)  -  COITROL  FILE 

33  c*******  KWLOG  (UIIT  2)  -  OUTPUT  USER'S  LOG 

34  c*******  KRIES  (UIIT  3)  -  lES  IIPUT  DATA  FILE 

35  c*e*«**e  KWIES  (UIIT  4)  -  OUTPUT  FILE  OF  SEASOIALLY  CORRECTED 

36  C*******  lES  DATA 


37  c«*e«e** 

38  CHARACTER*2  YES/'YE'/,FRSTYR/’IO’/,SCIDYR/'IO'/ 

39  CHARACTERvSO  HEADR 

40  IITEGER«4  HI.  LOW 

41  integer  region 

42  REAL*4  TT(200) ,TTDTID(200) ,TID(200) ,TIME(200) 

43  c  REALM  T}IP(200),PRS(200).ANB(200) 

44  REAL*4  TTSCF ( 200 ) , TDTSCF ( 200 ) 

46  REALM  MITH(24) ,CF(24) ,CF1(24) .CF2(24) .CF3(24) .DSLOPE(24) 

46  REALM  CFDIF.MDIF, YREID(2)  , YRHR 

47  REAL*8  DEL,LSTDEL.TDIF,SCF 

48  REAL*8  DYRHR,  DHMITH,  DLMITH 

49  PARAMETER (KRCTRL=1 .KWL0G=2.KRIES=3.KWIESM) 

50  lANELIST/CARDl/HEADR 

6 1  IAMELIST/CARD2/IPTS , lOYRS , FRSTYR , SCIDYR 

52  namolist/card3/region 
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63  DATA  IT0TL/0/.YREID/8760. 0,8760.0/ 

54  c******* 

56  C*******  IIITIALIZE  THE  YEARHOUR  AID  CORRECTIOI  FACTOR  ARRAYS 

56  C*******  PROGRAM  ASSUMES  THAT  THE  YEARHOURS  ARE  FOR  THE  FIRST 

57  c*«**«**  DAY  OF  EACH  MOITH. 

58  C****^**  THESE  VALUES  ARE  FOR  THE  GULF  STREAM  REGIOI. 

59  c******* 

60  DAT4  MITH/0.,  744.,  1416.,  2160.,  2880.,  3624., 

61  6  4344.,  5088.,  5832.,  6552.,  7296.,  8016., 

62  A  0.,  744.,  1416.,  2160.,  2880.,  3624., 

63  C  4344.,  5088.,  5832.,  6662.,  7296.,  8016./ 

64  DATA  CF 1/0. 00066 1663,  0.000143760,  0.0,  0.000244602, 

66  /  0.000681494,  0.000730828,  0.000743666,  0.000727823, 

66  /  0.000746362,  0.000860607,  0.000960963,0.000886401, 

67  /  0.000661663,  0.000143760,  0.0,  0.000244602, 

68  /  0.000681494,  0.000730828,  0.000743666,  0.000727823, 

69  /  0.000746362,  0.000860607,  0.000960963,0.000886401/ 

70  DATA  CF2/0. 00069029.  0.00028889,  0.0,  0.00001669, 

71  /  0.00034664,  0.00080489,  0.00116238,  0.00134841, 

72  /  0.00143492,  0.00136641,  0.00116881,  0.00097876, 

73  /  0.00069029,  0.00028889,  0.0,  0.00001669, 

74  /  0.00034664,  0.00080489,  0.00116238,  0.00134841, 

75  /  0.00143492,  0.00136641,  0.00116881,  0.00097876/ 

76  DATA  CF3/0. 00038613,  0.00012636,  0.0,  0.00006714, 

77  /  0.00046289,  0.00107709,  0.00166602,  0.00174333, 

78  /  0.00178230,  0.00169693,  0.00136379,  0.00082930, 

79  /  0.00038613,  0.00012636,  0.0,  0.00006714. 

80  /  0.00046289,  0.00107709,  0.00166602,  0.00174333, 

81  /  0.00178230,  0.00169693,  0.00136379,  0.00082930/ 

82  C******* 

83  C*******  OPEI  THE  IIPUT  AID  OUTPUT  DATASETS 

84  c******* 

86  OPEI(UIIT=KRIES,STATUS=’OLD' ,FORM=’ FORMATTED' ,READOILY) 

86  OPEI (UIIT=KWIES , ST ATUS= ’ lEW ’ . FORM= ’ FORMATTED ’ ) 

87  c******* 

88  C*******  READ  COITROL  CARD  FILE 

89  c******* 

90  READ(KRCTRL,IML=CARD1) 

91  READ(KRCTRL,IML=CAR02) 

92  REA0(KRCTRL.IML=CARD3) 

93  if  (region. cq. 1)  then 

94  do  67  i-1,24 
96  cf(i)*cfl(i) 

96  67  continue 

97  else  if  (region. eq. 3)  then 

98  do  68  i=l,24 

99  cf(i)=cf3(i) 

100  68  continue 

101  else 

102  do  69  i=l,24 

103  cf(i)=cfl(i) 

104  69  continue 
106  endif 

106 
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107  WRITE(*.42) 

108  42  F0IU(AT(1X,//,5X.’  SEACOR  HAS  TAKEI  OVER  AID  IS  PROCESSIIG . ' 

109  C******* 

110  C*******  IF  A  LEAP  YEAR,  ADJUST  THE  BEGIIIIIG  TIMES  OF  EACH  MOITH 

111  C*******  *- 

112  IF  (FRSTYR  .EQ.  YES)  THEI 

113  YREID(l) =8784.0 

114  DO  100  LP=3.12 

IIB  MITH(LP)=MITH(LP)+24.0 

116  100  COITIIUE 

117  ELSE  IF  (SCIDYR  .EQ.  YES)  THEI 

118  YREID( 2) =8784.0 

119  DO  110  LP=16.24 

120  MITH(LP)=MITH(LP)+24.0 

121  110  COITIIUE 

122  EID  IF 

123  c******* 

124  C*******  IF  DATASET  SPAIS  TWO  YEARS.  THE  FIRST  YEAR  WILL  HAVE 

125  C*******  lEGATIVE  YEARHOURS.  SO  RESET  THE  BEGIIIIIG  MOITHS 

126  C******* 

127  IF  (lOYRS  .EQ.  2)  THEI 

128  DO  115  LP=1,12 

129  MITH(.LP)=MITH(LP)-YREID(1) 

130  115  COITIIUE 

131  EID  IF 

132  c******* 

133  C*******  WRITE  HEADER  IIFO  TO  USER’S  LOG 

134  C******* 

135  20  WRITE (KWLOG, 405)  HEAOR 

136  405  FORMATC’l’ .T35, ’*•***  SEASOIAL  CORRECTIOI  FACTOR  PROGRAM 

137  6  ’•*•••’// ’0 ’ ,A80) 

138  WRITE(KWL0G,410)  IPTS.lOYRS,  FRSTYR,  SCIDYR 

139  410  FORMATC'O' ,110, '  SAMPLIIG  PERIODS  ARE  TO  BE  READ’, 

140  «  /’O  THE  DATASET  SPAIS ’,12,’  YEAR(S)', 

141  «  /’  IS  THE  FIRST  YEAR  A  LEAP  YEAR?  ’,A4, 

142  6  /’  IS  THE  SECOID  YEAR  A  LEAP  YEAR?’.A4) 

143  WRITE(KWL0G,415) 

144  415  F0RMAT(///6X. ’TABLE  OF  SEASOIAL  CORRECTIOI  FACTORS', 

145  «  /’0’,4(’  YRHR  ',5X.’  CF  ’.6X), 

146  «  /’♦’.4(’ _ ’.6X,’ _ ’.6X)) 

147  10  WRITE (KWLOG, 420)  (MITH(I) ,CF(I) ,MITH(I+6) ,CF(I+6) , 

148  «MITH(I+12) ,CF(I+12) ,MITH(I+18) ,CF(I+18) .1=1,6) 

149  11  COITIIUE 

150  420  F0RNAT(4(F8.0,5X,F8.4,6X)) 

151  C******* 

152  C*******  CALCULATE  THE  SLOPES  TO  BE  USED  DURIIG  IITERPLOATIOI 

153  C******* 

154  DO  40  1=1,24 

155  IF(I-24  .IE.  0)  THEI 

166  CFDIF  =  CF(I+1)  -  CF(I) 

167  MDIF=  MITH(I+1)  -  MITH(I) 

158  DSLOPE(I)=CFDIF/MDIF 

159  ELSE 

160  CFDIF=CF(1)-CF(I) 
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I1DIF=  YREID(IOYRS)  -  MITH(I) 

DSLOPE ( I) =cn)IF/MDIF 
EID  IF 
40  COITIIUE 
C««****«  — 

c****«**  IITIALIZE  THE  PARAMETERS  TO  BE  USED  FOR  READIIG  THE  DATA 

IF  (IPTS  .LT.  200)  THEI 
IGO  =  IPTS 
ILEFT  =  0 
ELSE 

IGO  =  200 
ILEFT  =  IPTS 
EID  IF 

c*«*««**  READ  II  BLOCK  OF  DATA;  IICREMEIT  COUITER 
46  COITIIUE 

c  READ(KRIES,426,EID=900)  (TT(II) .TTDTID(II) ,TID(II) ,PRS(IH) 

c  «  TMP(II).AMB(II).TIME(II), 11=1, IGO) 
do  16  in=l.ngo 

r«ad(kri«a ,426,«nd=900)tt(in) ,ttdtid(in) .tid(in) ,tiB«(in) 

16  continua 

426  F0RMAT(4E16.7) 

60  COITIIUE 

ILEFT  =  ILEFT  -  IGO 
C*«*«««* 

PROCESSIIG  LOOP  TO  BE  REPEATED  FOR  EACH  SAMPLIIG  PERIOD 

Ca«**««* 

DO  80  1=1, IGO 
ITOTL  =  ITOTL  +  1 
YRHR=TIME(I) 

DYRHR=DBLE(YRHR) 

C*«=a«** 

C***a**a  IF  IT  IS  THE  FIRST  TIME  THROUGH  LOOP, 

C«a*a*a*  SEARCH  TO  FIID  NOITH  WHICH  IICLUDES  CURREIT  YEARHOUR 

C******* 

IF  (ITOTL  .EQ.  1)  THEI 
DO  70  11=1,24 
DEL  =  DYRHR-DBLE(NITB(II)) 

IF  (DEL  .LE.  0)  THEI 
LOW  =  II- 1 
1I=II 

DHHITH=NITH(HI) 

DLMITH=NITH(LOW) 

TDIF  =  LSTDEL 
GO  TO  76 

ELSE  IF  (II  .LT.  24)  THEI 
LSTDEL=DEL 
ELSE 
LOW  =  II 
HI=25 

DLMITH=MITH(LOW) 

DHNITH= YREID ( lOYRS) 
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TDIF  =  DEL 
GO  TO  75 
EID  IF 

70  COITIIUE 
75  COITIIUE 
ELSE 

DEL=DYRHR-DHmTH 
IF  (DEL  .GT.  0.0)  THEI 
L0W=L0W+1 

IF(LOV  .GT.  24}  GO  TO  999 
DLmTH=mTH(LOW) 

HI=HI+1 

IF(BI  .LE.  24)  THEI 
DHI(ITH=DBLE(MITH(HI)  ) 

ELSE 

DHNITH= YREID ( 10 YRS ) 

EID  IF 
EID  IF 

TDIF=DYRHR-DLMITH 
EID  IF 

C******* 

c*******  IITERPOLiTE  TO  CILCULITE  SEASOIAL  CORRECTIOI  FACTOR 

SCF=  DBLE(CF(LOW))  +  TDIF*DBLE(DSLOPE(LO«)) 

TTSCF(I)*  TT(I)  +  SCF 
TDTSCF(I)=TTDTID(I)  +  SCF 
80  COITIIUE 
C******* 

c«*«**«*  WRITE  BLOCK  OF  CORRECTED  DATA  TO  DISK.  IF  EID  OF  DATA, 
write  wrap-up  IIFO  to  USER'S  LOG. 

c******* 

WRITE (KWIES, 425)  (TTSCF(II) .TDTSCF(II) ,TID(II) .TIMEdl) , 11=1 ,IGO) 
IFCIFLAG  .Eg.  -1)  GO  TO  899 
IF  (ILEFT  .LT.  IGO)  IGO  =  ILEFT 
IF  (ITOTL  .LT.  IPTS)  GO  TO  45 

899  WRITE(KWL0G,430)  ITOTL 

430  F0RMAT('0',I5, '  CORRECTED  TRAVEL  TIMES  WERE  WRITTEI  TO  DISK’) 
WRITE(*,43) 

STOP 

C******* 

ERROR  COIDITIOIS; 

C*******  1)  BID  OF  DATA  EICOUITERED  UIEZPECTSDLY 

900  COITIIUE 
IFUG=-1 

WRITE (KWLOG, 436) 

436  FORNATC'  FEWER  POUTS  THAI  EXPECTED  01  IIPUT'/ 

6  '  ITOTL  WILL  BE  REVISED’) 

IGO  =11-1 
GO  TO  SO 

C******* 

c***«***  2)  DATASET  SPAIS  MORE  THAI  TWO  CALEIDAR  YEARS 

999  COITIIUE 
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269  URITE(KVL0G,435) 

270  436  FORMlK'  RUl  TERMII4TED  •••♦•>/ 

271  «  '  D1T4SET  EXCEEDED  24  MOITHS') 

272  WRITE (*,43) 

273  43  F0RMAT(1X.//,5X, ’  YOUR  TEMIIiL  COITROL  HAS  lOW  BEEI  RETURIED.’) 

274  STOP 

276  EID 


1 1') 


3.8  RESPO_JUL88.FOR 

RESPOJUL88  is  linked  with  subroutines  and  functions  from  the  library  ‘V’AX.TIDELIB'.  RE- 
SPOJUL88  and  some  of  the  library  routines  (POTTY,  WEIGHTY,  SPONT'V',  TADM,  and  HG) 
are  listed  here.  — 

1  C  THIS  PROGRAM  DOES  TIDAL  RESPOISE  AIALYSIS  (SEE  NUIK  A  CARTWRIGHT, 

2  C  SUBROUTIIES  AID  FUICTIOIS  FROM  'TIDELIB'  ARE  USED. 

3  C  IMPLEMEITED  01  THE  PRIME  BY  DAVID  LAI  10/20/80. 

4  C  10  RESTRICTIOIS  01  THE  length  OF  SERIES  (PRIME  HAS  VIRTUAL 

5  C  MEMORY) .  COMPUTATIOIS  ARE  DOIE  OILY  OICE  THROUGH  THE  WHOLE  SERIE 

6  C  I.E.  SERIES  HOT  CUT  IITO  SEGMEITS. 

7  C  START  TIME  (SYY) .  length  OF  SERIES  (length).  DELTA  TIME  (D) 

8  C  lEED  TO  BE  PUT  II. 

9  C  DATA  READ  STATEMEITS  REQUIRED  CHARGES  ACCORDIIG  TO  DATASET. 

10  C  OPTIOIS  ARE  SET  BY  DATA  STATEMEITS: 

11  C  ***  FOLLOWIIG  VALUES  .EQ.  1  IIDICATE: : 

12  C  lADJD  —  SUBTRACT  MEAI  FROM  SERIES  AID  MULTIPLY  BY  CALIB. 

13  C  IDADM  —  COMPUTE  ADMITTAICE 

14  C  IDRSP  —  CREATE  PREDICTED  TIDE  SERIES 

15  C  IRESID  -  COMPUTE  RESIDUAL  SERIES 

16  C  FOLLOWIIG  VALUE  .EQ.O  IIDICATES  :: 

17  C  KOMPLX  —  OILY  REAL  PART  OF  PREDICTED  SERIES  IS  TO  BE  RETAIIED. 

18  C  FOLLOWIIG  VALUES  .LE.O  IIDICATE:: 

19  C  IPRIID  —  PRUT  PARTIAL  LIST  OF  lORMALIZED  IIPUT  DATA 

20  C  IPRIIP  —  PRUT  PARTIAL  LIST  OF  PREDICTED  TIDE 

21  C  IPRIIR  —  PRUT  PARTIAL  LIST  OF  RESIDUAL  SERIES 

22  C  OTHERWISE  THE  WHOLE  SERIES  ARE  PRIITED  ••• 

23  C  •••  FOLLOWIIG  QUAITITIES  DEPEID  01  TYPE  OF  TIDES  IIVOLVED. 

24  C  ***  SEE  LISTIIGS  OF  TIDELIB  SUBROUTIIES  FOR  DETAILS  **** 

25  C  LGAMMA,  lUMGMI,  BORDER ,  IDEGRE,  JP,  KP,  HH.  KB.  IP.  IPHGPl,  IH . 

26  c********************************* **************** 

27  C 

28  C  XXMl  DIMEISIOIED  AT  LEAST  4*IPH*(IPH+1)  WHERE  IPH  IS  THE  lUMBER 

29  C  OF  P.H  COMBIIATIOIS. 

30  C 

31  C  C  DIMEISIOIED  ATLEAST  ( 2*1 ength)+ 1000 

32  C 

33  C  Y  DIMEISIOIED  (length)  WHERE  length  IS  length  OF  TIME  SERIES 

34  C 

35  C  YPRED  DIMEISIOIED  (length) 

36  C 

37  C  I/O  FILES/PARAMETERS 

38  C  =======5================== 

39  c*****  KCTRL  (UlIT  13)  -  COITROL  FILE 

40  c*****  KOUT  (UIIT  16)  -  RESPO  OUTPUT 

41  c*****  KII  (UIIT  16)  -  DESPIKED  IIPUT 

42  C 

43  c======"=============================================="=========== 

44  paraaeter  (  n.dial  =  25000  ) 

45  paraaeter  (  n_dia2  =  2  *  n.dial  *  1000  ) 

46  PARAMETER(KCTRL=13.K0UT=16.KII=16) 

47  COMPLEX  C(n_dia2) 

48  COMMOl  /DUMl/  C 

49  COMMOl  /DUM2/  Y(n_dial) 
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50  COMMOI  /DUM3/  YPRED(n_di«l) 

51  CONNOI  /DUN4/  XXN1(728)  •  nph  =  13 

52  COMMOI  /DUM5/  YRHR(n_dial) 

53  COMMOI  /DUM6/  YRES(n_di«l) 

55  COMMOI  /RESTOR/  IIISHR,SXR,EXR.SYR.EYR,DR.LIMPR,KOMPLX 

56  COMMOI  /TEAPOT/  LEQPOT.LF.THETAO.PHIO.SD.DD.ED.IIISHT 

57  COMMOI  /WAITER/  IIISHL.IFIIAL.SX.EX.SY.EY.D.LIMP 

58  DOUBLE  PRECISIOI  YSUM 

59  DOUBLE  PRECISIOI  SD.DD.ED.SYY.EYY.ye&rh- 

60  DOUBLE  PRECISIOI  XXM 

61  DIMEISIOI  LGAMMA(10).M0BDER(10).IDEGRE(10),PHWTS(80).HH(10). 

62  +  JP(IO) ,H(10) ,IP(10) ,IH(10) 

63  DIMEISIOI  0RAY(20)  .ICOISTdO) 

64  DIMEISIOI  ITITLD(4).ITITLP(4).ITITLR(4) 

65  DIMEISIOI  XXM(l) 

66  CHARACTER«40  HEADR.FORM 

67  REAL  *8  AIAME(S),SAM 

63  integer  leap, spread 

69  EQUIVALEICECXXMKD.XXMd)) 

70  lAMELIST/CARDl/HEADR 

71  IAMELIST/CARD2/F0RM 

72  IAMELIST/CARD3/length,year .yearhr.D 

73  C************************************************** ****** «****«« 

74  DATA  AIAME/’IYY-I  'POTTY  ' , 'WEIHTY  ' , 'TADM  ’  , 'SPOITY  '/ 

75  DATA  ITITLD/4HllOR.4HMALI,4H7tD  ,4HDATA/ 

76  DATA  ITITLP/4HlPRE,4HDICT,4aED  T.4HIDE  / 

77  DATA  ITITLR/4H0TID,4HE  RE,4HSIDU,4HAL  / 

78  DATA  IDVTS/  1/ 

79  C  lADJD.IE.O  MEAIS  REMOVE  MEAI  FROM  SERIES  AID  MULTIPLY  BY  CALIB. 

80  data  lADJD/l/,  CALIB/1.0/,  IPRIID/-1/ 

81  DATA  IDADM/1/ 

82  DATA  IDRSP/1/  ,  KOMPLX/0/  .  IPRIIP/-!/ 

83  DATA  IRESID/1/  ,  IPRIIR/-!/  .  RSCALE/1E3/ 

84  DATA  LGAMMA  /3,3,  8*0/  ,  IUMGMI/2/ 

85  DATA  MORDER  /I. 2,  8*0/ 

86  DATA  IDEGRE  /2,2,  8*C ^ 

87  DATA  JP  /I, 2,  8*0/  .  KP/2/ 

88  DATA  HH  /  -48.  .  0.  ,  48.,  7*0.0  /  ,  KH/3/ 

89  C  DATA  HH  /-9e. .-48. ,0. .48. ,96..6*0.0/,  KH/5/ 

90  DATA  HP/0,2.  8*0/  .  IPHGPl/2/ 

91  DATA  IH/0.3.  8*0/ 

92  C  DATA  IH/0.6.8*0/ 

93  C***************************************************************** 

94  HCORR(HHH)=FLOAT(IROUID(HHH/D))*D 

96  !  900  FORMATdO’ .F9.6,11F10.6) 

96  900  F0RMAT(’0‘.6fl6.6) 

97  90  F0RMATd2F6.2) 

98  91  F0RMAT(4A4//<6(F10.3.FP  ?))) 

99  81  FORMAT('OSYY=  '.D20.10,'  length=’.I10  ’  D=’.D20.10.'  EYY= ’ .D20. 10) 

100  910  F0RMAT(9H1ISKIPR  =.I6) 

101  2  F0RMAT(3H0  .A6.F6.0) 

102  443  FORMAT (8H0PHWTS  =) 

103  444  F0RMAT(F6.0.F8.2.2F11.6) 


**«*««*«**•********««******* 
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C* ******************** **«***********^*^ 

C  IfSERT  SYY=START  TIME  II  HOURS  FROM  BEGIIIIIG  OF  THIS  CEITURY 

C  ♦**  l«ngth= length  OF  SERIES 

C  *•*  D=DELTA  TIME  II  HOURS 

open(Uf IT=kG* rl , 8tatus= ' old ' , FORM= 'FOfiJATTED ' , READOILY) 

read(kctrl,IML=CARDl) 

read(kctrl,IML=CARD2) 

READ (KCTRL , IML=CARD3 ) 

C***** 

C*****  Conversion  fro«  year  k  year  hour  to  Year  Hour  fro*  1900 
C***** 

Cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 
C*****  correction  to  conversion.  Spread  vas  previously  defined  as 
C*****  8pread=year-1900 

C*****  The  subtraction  of  unity  insures  the  proper  treatment  of  a  leap 
C*****  year.  This  sas  verified  with  Dr  WiMbush’s  Kalday  function. 

C*****  A  negative  yearhr  error  trap  was  removed.  Kao'en  amd  I  were 
C*****  able  to  justify  why  positive  year  hours  wore  necessatry. 

C*****  E. Fields  9-Feb-90 

Ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 
8pread=y ear- 1900-1 
leap=int(8pread/4. ) 

8yy=  (spreadt  1 )  *8760+f  loat  (leap)  ♦24+y  eairhr 
print  •.HEADR.FORM 
print  *, length, year, yearhr 
C  if  (yearhr .LT. 0.0)  then 

C  print  41,headr 

C  41  formate  lx, a40./,Sx, 

C  C  'error  in  input  yearhr.  It  must  be  positive!’) 

C  call  exit 

C  end if 

c  *«*«*•«  eid  of  IIPUT 

Q»*^^^**^*^**^^itt********* **************************  ****** 

EYY=S YY+DBLE ( FLOAT ( 1 engt h- 1))*D 
PRUT  81, SYY, length, D,EYY 
H(1)=HC0RR(HH(1)) 

HMII=H(1) 

HMAX=H(1) 

DO  820  I=2,KH 

HCD^^HCORRCHHCD) 

IF(H(I).LT.HMII)  HMII=H(I) 

IF(H(I).GT.HMAX)  HMAX=H(I) 

820  COITIIUK 
C 

TIDPOT  ♦♦♦ 

LEqP0T=l 

LF=0 

THETA0=0 . 

PHI0=0. 

SD=SYY+DBLE(HMII) 

DD-D 

ED=EYY+DBLE(HMAI) 
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IIISHT=1 

TRY=P0‘m  (LGAMJU .  MORDER . IDEGRE ,  HJUGMI .  C ,  ITIM) 

SAM=AIAME(2) 

PRIIT_2.SAM,TRY 
IFdRY.EQ.O.)  GO  TO  40 
CALL  EXIT 
40  COITIIUE 

PRUT  769,  ITIM 

769  FORMATCOITIM  =’ .16) 

PRUT  336,  (C(I).  1=1,12) 

!  PRUT  336,  (C(I).  1=1.200) 

336  FORMAT (27H0-TIDP0T  SERIES  BEGIIIIIG  - , (/4(6X .2F12 . 6) ) ) 

C 

C  TIDWTS  •** 

C 

C  CHECK  TO  READ  II  WEIGHTS 

IF(IDWTS.GT.O)  GO  TO  48 
KPS=1 

KPHWTS=4*MAX0(KPS . -IDWTS) 

READ  444.  (PHWTS(I) , 1=1 .KPHWTS) 

48  IIISHL=1 
IFIIAL=1 
SY=SYY 
EY=EYY 
D=DD 
SX=SD 
EX=ED 

LIMP=IUMGMI 

IFCIDWTS.LE.O  .AID.  (IDRSP.LE.O  .OR.  IRESID.LE.O))  GO  TO  106 

C*««*«*«**«*««««««**«**«**«««***«**«*««4>«*«**«**«*«*«*4r«******** 

C 

C 

C  READ  II  DATA  SERIES  **••**•* 

C 

op«n(UIIT=kin.8tatu«='ol<l' , FORM=' FORMATTED ’ .READOILY) 
READ(KII.FORM)  (Y(I),  yrhr(i),  1=1, length) 

!  do  nn  =  1  ,  length 

1  yCnn)  =  ylnnj  *  100. 

!  enddo 

C 

C 

c  *****  bid  of  read  data  *•••♦**** 

C 

c************************************************************** 

IY=IIT(1.5+(EY-SY)/D) 

PRUT  770,  lY 

770  FORMAT (’OIY  =’,I6) 

PRUT  900,  (Yd).  1=1,12) 

IYM11»IY-11 

PRUT  900,  (Y(I),  I=IYM11,IY) 

YSUM=0. 

DO  70  1=1, lY 

YSUM=YSUM+DBLE(Y(I)) 

70  continue 


212 

213 

214 

215 

216 

217 

218 

219 

220 
221 
222 

223 

224 
226 
226 

227 

228 

229 

230 

231 

232 

233 

234 

235 

236 

237 

238 

239 

240 

241 

242 

243 

244 

245 

246 

247 

248 

249 

250 
261 

252 

253 

254 

255 
266 

267 

268 

259 

260 
261 
262 

263 

264 
266 


YAVE=YSU1!/DBLE(FL0AT(IY)  ) 

PRUT  771,  YAVE 
771  FORMATCOYAVE  =’ .E13.7) 

KUP=MII0(IY.500) 

IFdADJD.LE.-O)  GO  TO  96 
C  REMOVE  NEAR  AID  lORNALIZE 

PRUT  775,  CALIB 
776  FORMATCOCALIB  =',E12.4) 

DO  80  1=1, lY 

Y{I)=(Y(I)-YAVE)*DBLE(CALIB) 

80  continue 

IIY=IY 

IFdPRIID  .LE.  0)  IIY=KUP 
PRUT  91,  ITITLD,(Yd),  1=1, IIY) 

96  IFdDWTS.LE.O)  GO  TO  106 

PRUT  8006,  (IPd),  I=1,IPHGP1) 

8006  FORNATdO  IP  >,3014) 

TRY=WEIHTY(C,  Y,  JP,KP,  H.KH,  IP,IH,IPHGP1,  XXMl.XXM, 
+  PHWTS,KPHWTS) 

SAN=AIANE(3} 

PRUT  2, SAM, TRY 
IF(TRY.EQ.O.)  GO  TO  100 
CALL  EXIT 
100  IIISHL=0 
106  PRUT  443 

PRUT  444,  (PHWTSCI),  I=1,KPHWTS) 

C 

C  TIDADM 

IFCIDADM  .LE.  0)  GO  TO  220 
KEEP=1 

DO  200  IC=1,IUMGMI 
CMPIT=FLOATdC) 


IF(LGAMMAdC)  . 

Eq. 

4) 

GO 

TO 

190 

IF(IDEGREdC) 

.GT, 

.2) 

GO 

TO 

3000 

IF(MORDERdC), 

,E0. 

.0) 

GO 

TO 

2600 

DELF=0. 03660 11 

IF(MOROERdC) 

•  Eq 

.2) 

GO 

TO 

2000 

FS=0 . 8929346 
IC0IST(1)=2 
IC0IST(2)=4 
IIC=2 

166  ITYPE=10 
L0=10 

TRY«TADM(PHWTS,KPHWTS,  ORAY,LO,  FS,DELF,  CMPIT,KEEP) 
CALL  H6(0RAY,L0,  ICOIST,IIC,  MORDERCIC),  ITYPE) 
SAM=AIANE(4) 

PRUT  2, SAM, TRY 
IF(TRY.Eq.O.)  GO  TO  170 
CALL  EXIT 

170  DELF=0. 104018 
FS=0. 8932441 

IF(M0R0ERdC).Eq.2)  FS=1. 895982 
1TYPE=10 
175  L0=4 
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266 

267 

268 

269 

270 

271 

272 

273 

274 
276 

276 

277 

278 
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280 
281 
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283 

284 

285 

286 

287 

288 

289 

290 

291 

292 

293 
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299 

300 

301 

302 

303 

304 
306 

306 

307 

308 

309 

310 

311 

312 

313 

314 
316 

316 

317 

318 

319 


180  TRy=TADM(PHWTS,KPHWTS.  ORAY.LO,  FS.DELF,  CMPIT.KEEP) 
iCOIST(l)=l 
iCQIST(2)=2 
IIC=2 

CAll  HGCORAY.LO,  ICOIST.IIC,  MORDER(IC) ,  iTYPE) 

SAN=AIAME(4) 

PRUT  2, SAM. TRY 
IF(TRY.Eq.O.)  GO  TO  200 
CALL  EXIT 

190  DELF=0. 0064768 19 

FS=0. 9972620907 
IF(IDEGRE(IC).EQ.l)  FS=1.0 
IF(M0RDER(IC).EQ.2)  FS=2.0 
■TYPE=-IFIX(2.*ABS(l.-FS)+0.999) 

L0=4 

GO  TO  180 

2000  FS= 1.86907 14 

■C0fST(l)=3 
IC0IST(2)=6 
»C=2 
GO  TO  166 

2600  FS=0. 00647682 

DELF=0. 06772639 
■TYPE=-10 
GO  TO  176 

3000  IF(M0RDER(IC).IE.3)  GO  TO  3300 
DELF=0. 036291647 
FS=2. 8621 18775 
3200  ITYPEsIROUIDCFS) 

L0=>4 

GO  TO  180 

3300  DELF=0. 073202204 
FS=0. 9664462631 

IF(MORDER(IC) . EQ . 2)  FS=1 . 895672614 
GO  TO  3200 
200  CQITIIUE 

PRUT  8006,  (IPd),  I=1,IPHGP1) 

C 

C  TIDRSP 

220  IF(IDRSP.LE.O)  GO  TO  160 
LIMPR=LIMP 
■P(2)=KP 

C  ■P{2)=1  ~  PREDICTED  TIDES  COISIST  OF  OILY  SEMI-DIURIAL 

C  IP(2)*1 

C  ***** 

■PGP1=2 

IlISHR^l 

SXR=SX 

EXR=EX 

SYR=SY 

EYR=EY 

DR-D 

TRY=SPOITY(C,  PHWTS.KPHWTS,  JP.  IP.IPGPl,  YPRED.KY) 

C  ****  F0LL09IIG  STATEMEIT  COMPUTES  OILY  SEMI-DIURIAL  TIDES 
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320 

321 

322 

323 
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326 

327 

328 

329 

330 

331 

332 

333 

334 

335 

336 

337 

338 

339 

340 

341 

342 

343 

344 

345 

346 

347 

348 

349 

360 

361 

362 

363 

364 
366 

366 

367 

368 

369 

360 

361 

362 

363 

364 
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1 

2 

3 

4 
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6 

7 
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C  TRY=SP0ITY(C,  PHWTS.KPHWTS,  2,  IP. 2.  YPRED.KY) 

SAN=mNE(6) 

PRUT  2. SAM, TRY 
IFCTRY.EQ.O.)  GO  TO  130 
CALL  EXIT 
130  COITIIUE 

PRUT  772,  KY 
772  FORMATCOKY  =*.16) 

K0MP=NII0(2,IABS(K0MPLX)-t-l) 

KYY=KOMP*KY 

KUP=MII0(KY,600) 

IIY=KY 

IFdPRIIP  .LE.  0)  IIY=KUP 
IIY=KOMP*IIY 

PRUT  91.  ITITLP.CYPREDd),  1=1, IIY) 

160  IFCIRESID  .LE.  0)  GO  TO  160 
IF(KONPLX  .IE.  0)  GO  TO  163 
DO  162  1=1, KY 

YRES ( I) =Y (I ) - YPRED (I ) 

152  continue 
GO  TO  ISO 

163  DO  164  1=1, KY 

YRESd)=Yd)-YPRED(2*I-l) 

164  continue 
156  IIY=KY 

IFCIPRIIR  .LE.  0)  IIY=KUP 
ISKIPR=MAX0(1,IPRIIR) 

PRUT  910,  ISKIPR 

PRUT  91,ITITLR,(YRESd),  1=1 , IIY, ISKIPR) 

160  COITIIUE 

C 

C  WRITE  RESIDUAL  TIME  SERIES 

C 

OPEI (UIIT=KOUT , 8tatU8= ’ new  * , FORM= ’ FORMATTED  * ) 
do  13  i=l,  ky 

WRITE(K0UT.162)  y(i) .yreeCi) .ipred(i) .yrhr(i) 

13  continue 
162  F0RMAT(4ei5.7) 

CLOSE(KII) 

close(kctrl) 

CLOSE  (KOUT) 

C 

c***************************************************************** 

CALL  EXIT 
EID 

FUICTIOI  POTTY(LGAMMA,MORDER,IDEGRE.IUMGMI,  C.ITIM) 

C 

C  TITLE  -  POTTY  =  POTEITIAL  TYDE 
C  GEIERATIOI  OF  TIDE  POTEITIALS 
C 
C 

C  - ABSTRACT— 
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C 

C 

C 

C 

C 

C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


IF  LEQPOT  .IE.  0  POTTY (LG ANNA, NOROER.IDEGRE.IUNGMI, 
C.ITIN)  GEIERATES  FUICTIOIS  RELATED  TO  THE  TIDE 
POTEITIALS.  THE  FUICTIOIS  ARE  lOT  CONFUTED  AS  A  SUPER- 
POSITIOI  OF  TINE  HARNOIICS  II  THE  CLASSICAL  SEISE,  BUT 
DIRECTLY  FRON  THE  KlOUl  ORBITAL  COISTAITS. 

(StE  V.H.  *rJIK  AID  D.E.  CARTWRIGHT.  1966  TIDAL  SPECTRO¬ 
SCOPY  AID  PREDICTIOI,  PHIL.  TRAIS.  ROY.  SOC.  A.  269, 
633-681) 

IF  LEQP0T=0  POTTY(LGANNA,NORDER,IDEGRE,IUNGNI.C) 
GEIERATES  THE  GANNA  EQUILIBRIUN  TIDE  AT  A 
PLACE  THETA, PHI  (II  DEGREES)  AS  DERIVED  FRON  THE  FUIDA- 
NEITAL  DEFIIITIOIS  WITHOUT  EXPAISIOI  IITO  SPHERICAL 
HARNOIICS. 


—STATISTICS— 

LAIGUAGE  -  FORTRAI  IV  (CDC3600.B6600) 

EQUIPNEIT  -  10  SPECIAL  REQUIRENEITS 

STORAGE  -  6 10 (OCTAL)  =  392(DECINAL)  LOCATIOIS 

SPEED 

AUTHOR  -  NARK  WINBUSH  IGPP  JUL  1970 

LAST  NOD  -  NARK  WINBUSH  lOVA  APR  1972 

CATAGORIES 
STATUS 

LIBRARY  ROUTIIES  USED  -  ANEIPI,  RECURO,  SHNIDT,  SETUPN,  ORBITS 
SYSTEN  ROUTIIES  USED  -  02007110, Qiq00310,QlQ04310,Qiq04330,QlQ02330, 
DNOD , XIITF , SORTF , SIIF , COSF , AINAG 


- USAGE - 


SANPLE  CALL 

J  :::  POTTY  (LG  ANNA .  NORDER  .IDEGRE ,  lUNGNI .  C.ITIN) 

lOTE  -  DINEISIOI  OF  ARRAY  C  IS  IUNGNI*ITIN 

(CONPLEX  UNLESS  LEQP0T=0) 


INPUTS 

LGANNA(I)  =1  FOR  NOOI«S  GRAVITATIONAL  POTENTIAL 
=2  FOR  SUNOS  GRAVITATIONAL  POTENTIAL 
=3  FOR  TOTAL  GRAVITATIONAL  POTENTIAL 
=4  FOR  SUNOS  RADIATIOIAL  POTENTIAL 

NORDER(I)  VALUE  OF  N  IN  ITB  TRIPLET 
(ORDER  OF  SPHERICAL  HARNOIIC) 

NOT  NEAIIIGFUL  IF  LEQPOT^O 

NDEGREd)  VALUE  OF  I  IN  ITH  TRIPLET 
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63 

C 

(DEGREE  OF  SPHERICAL  HARNOIIC) 

64 

C 

lOT  NEAIIIGFUL  IF  LEQPOTsO 

68 

C 

66 

C 

lUMGMI 

HUMBER  OF  GAMMA.K.I  TRIPLETS 

67 

C 

68 

C 

- COMMOI  /TEAPOT/ 

69 

C 

70 

LEQF3T 

=0  IF  THE  EQUILISRIUM  TIDE  IS  TO  BE  STORED  AT  C. 

71 

c 

LF  AID  ARRAYS  BORDER  AID  IDEGRE  ARE  HOT  NEAIIIGFUL 

72 

c 

AID  ARE  HOT  CHECKED. 

73 

c 

•IE.  0  IF  TIDE  POTEITIALS  ARE  TO  BE  STORED  AT  C. 

74 

c 

75 

c 

LF 

=0  IF  THETAO  AID  PHIO  ARE  TO  BE  IGIORED 

76 

c 

lOT  NEAIIIGFUL  IF  LEQPOT^O 

77 

c 

78 

c 

THETAO 

LOCAL  COLATITUDE,  II  DEGREES 

79 

c 

(HEEDED  OILY  IF  LF  .IE.  0  OR  IF  LEqP0T=0) 

80 

c 

81 

c 

PHIO 

GREEIUICH  EAST  LOIGITUDE,  II  DEGREES 

82 

c 

(HEEDED  OILY  IF  LF  .IE.  0  OR  IF  LEQPOT=0) 

83 

c 

84 

c 

SO 

START  TINE  II  HOURS  (DOUBLE  PRECISIOI) 

85 

c 

86 

c 

DD 

IICRENEIT  TINE  II  HOURS  (DOUBLE  PRECISIOI) 

87 

c 

88 

c 

EO 

EID  TINE  II  HOURS  (DOUBLE  PRECISIOI) 

89 

c 

90 

c 

lOTE.  ZERO  TINE  IS  TAKEI  TO  BE  1900  JAI  1  OOOOHRS  GNT 

91 

c 

92 

c 

IIISHL 

MUST  BE  SET  lOI-ZERO  II  IIITIAL  CALL  OF  POTTY. 

93 

c 

II  FURTHER  CALLS,  IIISHL  NAY  BE  SET  TO  ZERO  IF  THS  OALY 

94 

c 

OTHER  CHARGED  IIPUT  PARAMETERS  ARE  SD,  DD,  AID  ED 

95 

c 

96 

c 

97 

c 

OUTPUTS 

98 

c 

99 

c 

POTTY 

=0.  IF  IIPUT  ITEMS  HAVE  VALID  VALUES 

100 

c 

=1.  IF  NORDER  .GT.  IDEGRE 

101 

c 

=2.  IF  IDEGRE  .LT.  1 

102 

c 

=3.  IF  NORDER  .LT.  0 

103 

c 

=4.  IF  LGANMA  .LT.  1  OR  LGANNA  .GT.  4 

104 

c 

s6.  IF  lUNGNI  .LT.  1 

105 

c 

=6.  IF  IMPOSSIBLE  COLATITUDE  (THEATO) 

106 

c 

*7.  IF  INVALID  TINE  GROUP  (SD,DD,ED) 

107 

c 

108 

c 

C 

IF  LEQPOT  .IB.  0,  THE  MERGED  COMPLEX  SERIES  C  OR  F  OF 

109 

c 

TIDE  POTEITIALS  ACCORDIIG  AS  LF=0  OR  1  (SEE  EQI.  A7 

110 

c 

OF  NUIK  AID  CARTWRIGHT  OR  DESCRIPTION  OF  BOON  STATEMENT 

111 

c 

TIDPOT) 

112 

c 

IF  LEQPOT  =  0,  THE  GANNA  EQUILIBRIUM  TIDE  F(THETAO ,PHIO) 

113 

c 

AS  DERIVED  FROM  THE  FUIDANEITAL  DEFIIITIOIS  WITHOUT 

114 

c 

EXPAISIOI  IITO  SPHERICAL  HARNOIICS. 

116 

c 

116 

c 

ITIN 

NUMBER  OF  DIFFERENT  TINES  FOR  WHICH  TERNS  OF  C  ARE 
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117 

118 

119 

120 
121 
122 

123 

124 

125 

126 

127 

128 

129 

130 

131 

132 

133 

134 

135 

136 

137 

138 

139 

140 

141 

142 

143 

144 

145 

146 

147 

148 

149 

150 

151 

152 

153 

154 

155 

156 

157 

158 

159 

160 
161 
162 

163 

164 

165 

166 

167 

168 

169 

170 


C  COMPUTED  -  I.E.  IIT(1 .6+(ED-SD)/DD) 

C 

C 

C  EXAMPLES 

C 

C 

C  PROGRAM  FOLLOWS  BELOV 
C 

!  iaplicit  realms  (a-h,o-z) 

COMMOI  /TEAPOT/  LEQPOT.LF.THETAO.PHIO.SD.DD.ED.IIISHL 
COMMQV  /VORKIV/  XIPI(138) .RA0I(16) .DEIMLS(17} .DEIMLM(17) , 

1  DEIMLF(17) .REq(286) .qs(153) ,qM(153) .qF(153) 

COMMOI  /PQTLUK/  LAST.F.CTHETA,STHETA.CZ(2) .SZ(2) .BIGL(2) ,RBDR(2) , 
1  TD.RR 
cWWWWWW 

raal*8  SD,DD,ED.TD.TGP12D 
!  r«al*8  paz.aadaa.pidlSO 

COMPLEX  DEIMLS.DEIMLM. DEIMLF.dk. CK 

DIMEISIOI  LGAMMA(IUMGMI) .MORDER(IUMGMI) .IDEGRE(IUMGMI) . 

1  C(1).PAX(2).AMDME(2) 

C  (SEE  6I0TEC  ABOVE  FOR  TRUE  DIMEISIOI  OF  C) 

EqUIVALEICE  (IGMI.XfPI(l)) 

C  1964  I.A.U.  ASTROIONICAL  COISTAITS  (SEE  AMERICAI  EPHEMERIS  AID 
C  lAUTICAL  ALMAIAC  1971.  P.481) 

C  SOUR  PARALLAX  -  8M.794 

C  (8 . 794/3600 . ) * (PI/180 . ) =4 . 26346151 17E-5 

C  SHE  PARALLAX  FOR  MOOI  =  3422M.451 
C  (3422.451/3600. )*(PI/180.)=1.6692610677E-2 
C  AEqUATORlAL  »  6378160  M 

C  MSUI/(MEARTH-»'MMOOI)  =  328912  .  NEARTH/MMOOI  =  81.30 
C  (6378160. *100. CM)*328912.*(1.+1./81.30)=2.1236672163E14  CM 

C  (6378160. *100. CM)/81. 30=7. 8462152522E6  CM 

DATA  PAX  /4.2634615117a-6,  1 .6692610677e-2/. 

1  AMDME  /2.1236572163«14.  7.8452152522«6/. 

2  PID180  /.01746329262«0/ 

C  .  POTTY  IS  THE  MAH  HDEPEIDEIT  SUBPROGRAMME  FOR  STATEMEITS 
C  «TIDPOT«  AID  «TIDEqU«.  (PROGRAMME  AID  ASSOCIATED  SUBROUTHES 
C  WRITTEI  BY  NARK  HIMBUSH  -  JULY  1970) 

P0TTY=0. 

IF(SD.IS.ED)  GO  TO  10 

mM=i 

GO  TO  30 

10  0DENSD=SIGL(D0/(ED-SD)) 

IF(DDENSD.GT.O.)  GO  TO  20 
P0TTY=7 . 

GO  TO  40 

20  ITIM=HT(1./DDEMSD+1.5) 

C  SKIP  lEXT  SECTIOI  IF  lOT  HITIAL  CALL 
30  IFdllSHL.Sq.O)  GO  TO  70 
PHI=PHI0*PID180 
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172 

173 

174 

175 

176 

177 

178 

179 

180 
181 
182 

183 

184 
186 
186 

187 

188 

189 

190 

191 

192 

193 

194 

195 

196 

197 

198 

199 

200 
201 
202 

203 

204 

205 

206 

207 

208 

209 

210 
211 
212 

213 

214 

215 

216 

217 

218 

219 

220 
221 
222 

223 

224 


THETA=THETA0*PID180 
CTHETA=C0S (THETA) 

STHETA=SII (THETA) 

IFdUMGMI.LT.l)  P0TTY=6. 

IF(STHETA.LtTo. .aid. (LEqPOT.EQ.O.OR.LF.IE.O))  P0TTY=8. 

40  IF(POTTY.IE.O.)  RETURI 

C  COMPUTE  IMAX  (MAXIMUM  X) .  IRMAX  (MAXIMUM  RADIATIOIAL  H) , 

C  FORM  LAST  ACCORUIIG  TO  OESCRIPTIOI  ABOVE,  AID  CHECK  FOR  IIVALID 

C  GAMMA, M, I  TRIPLETS  (ASSIGIIIG  VALUES  TO  POTTY  ACCORDIIG  TO 

C  DESCRIPTIOI  ABOVE) 

HMAX=0 

IRMAX=0 

LAST=0 

MAST=-1 

DO  60  IGMI=1,IUMGMI 
LG=LGAMMA(IGMI) 

M=MORDER(IGMI) 

I=IDEGRE(IGMI) 

IF(LEqPOT.Eq.O)  GO  TO  60 
IF(I.GT.IMAX)  IMAX=I 
IF(LG.Eq.4.AID.I.GT.IRMAX)  IRMAX=I 
IF(M.GT.I)  P0TTY=1. 

IF(I.LT.l)  P0TTY=2. 

IF(M.LT.O)  P0TTY=3. 

60  IF(LG.LT.1.0R.LG.GT.4)  P0TTY=4. 

C  IF  BAD  GAMMA, M, I  TRIPLET  IS  FOUID,  RETURI 
IF(POmr.IE.O.)  RETURI 
IF(LG.IE.l)  MAST=1 
IF(LG.IE.2.AID.LG.IE.4)  LAST=1 
60  COITIIUE 

LAST=LAST*MAST 

IMAXP1=IMAX>1 

C -  SKIP  lEXT  SECTIOI  IF  STATEMEIT  IS  «TIDEqU« 

IF(LEqPOT.Eq.O)  GO  TO  70 

C -  CALCULATE  TIME  IIDEPEIDEIT  FACTORS,  ALSO  CALCULATE  COEFFICIEITS 

C -  FOR  RECURSIOI  FORMULA  USED  TO  GEIERATE  SCHMIDT  FUICTIOI  PART 

C—  OF  SPHERICAL  HARMOIICS 

CALL  ANEIPI(PAX,AHDME,  LGAMMA,IDEGRE,HUMGMX,  IRMAX) 

CALL  RECURq(IMAX) 

FaO. 

C -  SKIP  lEXT  SECTIOI  IF  «F€  IS  lOT  SET 

IF(LF.Eq.O)  GO  TO  70 

C -  COMPUTE  COMPOIEITS  OF  SPHERICAL  HARMOIICS  AT  THE  LOCATIOI 

C -  THETA, PHI 
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225 

226 

227 

228 

229 

230 

231 

232 

233 

234 
236 

236 

237 

238 

239 

240 

241 

242 

243 

244 
246 

246 

247 

248 

249 
260 
261 
262 

263 

264 
266 
266 

267 

268 
269 
260 
261 
262 

263 

264 
266 
266 

267 

268 

269 

270 

271 

272 

273 

274 
276 

276 

277 

278 


CALL  SHMIDTdMAX.CTHETA.STHETA,  QF) 

F=l. 

CALL  SETUPM(PHI,  DEINLF.IMAXPl) 

F=-F 

70  K=1  ~ 

C—  SD(DD)ED  ARE  START(IITERVAL)EID  TINES  II  HOURS  SIICE 
C -  1900  JAI  1  0000  HRS  GMT 

TGP12D=SD+12D0 
DO  260  ITIM=1,ITIM 

HR-SIGL (DMOD (TGP 12D , 24D0 ) ) 

C -  TD  IS  TINE  II  JULIAI  CEITURIES  SIICE  1899  DEC  31  1001  GNT 

TD=TGP 1 2D/876600D0 

C -  CALCULATE  lEEDED  ORBITAL  PARAMETERS  OF  SUI  AID  NOOl 

CALL  ORBITS 

C -  BRAICH  IF  STATENEIT  IS  «TIDEQU« 

IF(LEQPOT.EQ.O)  GO  TO  200 
c\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ 

C -  SKIP  lEXT  SECTIOI  IF  ALL  GANNAS  ARE  «NG« 

IF(LAST.Eq.-l)  GO  TO  80 

C -  COMPUTE  SPHERICAL  HARNOIIC  COMPOIEITS  OF  GREEIWICH  COORDINATES 

C -  OF  SUI 

CALL  SHMIDT(INAX.C2(1),S2(1),  QS) 

CALL  SETUPN(BIGL(1).  DEINLS.IHAXPl) 

C -  SKIP  lEXT  SECTIOI  IF  ALL  GANNAS  ARE  CSGC  OR  CRADC 

IF(LAST.EQ.O)  GO  TO  90 

C -  COMPUTE  SPHERICAL  HARNOIIC  COMPOIEITS  OF  GREEIWICH  COORDIIATES 

C -  OF  NOOl 

80  CALL  SHNIDT(INAX,C2(2),S2(2),  QN) 

CALL  SETUPN(BIGL(2) ,  OEINLN.INAXPl) 
c\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ 

90  11=1 

DO  190  I=1.IUNGNI 
NP1=N0RDER(I)^1 
IP1=IDEGRE(I)+1 
J=IPl*(IPl-l)/2+NPl 
LG>LGANMA(I) 

CK=(0. ,0.) 

100  XK=XIPI(II) 

IF(XX.Eq.O.}  GO  TO  180 
GO  TO  (160,130,120,110,160),  LG 
110  RX=RBDR(1)*«2 

GO  TO  140 
120  LG=6 

130  RX=RBDR(1)«*IP1 

140  qK=qs(J) 

DK=DEINLS(NP1) 

GO  TO  170 
160  LG=0 

160  RK=RBDR(2)««IP1 
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279 

QK=qi!(J) 

280 

DK=DEINLN(NP1) 

281 

C - 

COMPUTE  C  =  A  +  IB 

282 

170 

CK=CK+XK*RK*QK*DK 

283 

180 

11=11+1  - 

284 

IF(LG.Eq.5)  GO  TO  100 

285 

C - 

IF  «F«  IS  SET  MULTIPLY  BY  VALUE  OF  SPHERICAL  HARMOIIC  AT 

286 

C - 

LOCATIOH  THETA, PHI 

287 

IF(LF.IE.O)  CK=qF(J)*DEIMLF(MPl)+CK 

288 

C(2+K-1)=REAL(CK) 

289 

C(2+K)=AIMAG(CK) 

290 

IF(MPl.Eq.l)  C(2*K)=1. 

291 

190 

K=K+1 

292 

GO  TO  ■'60 

293 

c\\\\\\\\\\\\\\\ 

294 

C 

STATEMEIT  IS  CTIDEqUC  -  COMPUTE  EqUILIBRIUM  TIDE  AT  THETA. PHI 

295 

200 

DO  250  I=1.IUMGMI 

296 

SFK=0. 

297 

LSM=1 

298 

IF(LGAMMA(I).Eq.l)  LSM=2 

299 

210 

CALFA=CTHETA*CZ(LSM)+STHETA*SZ(LSM)+COS(PHI-BIGL(LSM)) 

300 

IF(LGAMMA(I).Eq.4)  GO  TO  220 

301 

P=PAX(LSM)+RBDR(LSM) 

302 

IF(LSM.IE.2)  GO  TO  230 

303 

SFK=SFK+ AMDME( 2 ) ♦P* ( 1 . /SORT ((P-2. *CALFA ) +P+ 1 . ) - 1 . -P+CALFA ) 

304 

GO  TO  240 

305 

220 

RK=RBDR(1)**2 

306 

SFK=-.25*RK 

307 

IF(CALFA.GT.O.)  SFK=SFK+CALFA*RK 

308 

GO  TO  240 

309 

230 

GAM=(2.*CALFA-P)*P 

310 

SFK= AMDME ( 1 ) ♦P* ( ( ( . 2734375+GAM+ .3125) ♦GAM+ . 375) * 

311 

+  GAM++2-.5+P++2) 

312 

IF(LGAMMA(I).1E.3)  GO  TO  240 

313 

LSM=2 

314 

GO  TO  210 

315 

240 

C(K)=SFK 

316 

250 

K=K+1 

317 

318 

C - 

IF  EID  TIME  HOT  REACHED,  GO  BACK  AID  DO  CALCULATIOIS  FOR 

319 

C - 

lEZT  TIME  STEP 

320 

321 

260 

TGP12D  =  TGP12D  +  DD 

322 

323 

RETURI 

324 

325 

EID 

1 

FUICTIOI  HEIHTYd,  Y,  JP.KP,  H,KH,  IP.IH.IPHGPl ,  XXMl.XXM, 

2 

1  PHWTS.KPHWTS) 

3 

C 

4 

C 

5 

C  TITLE  -  WEIHTY  =  WEIGHTS.  TYDE 

6 

C 

GEIERATES  OPTIMUM  PREDICTIOI  WEIGHTS 

7 

C 
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8 

9 

10 

11 

12 

13 

14 

15 

16 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 

51 

52 

53 

54 

55 

56 

57 

58 

59 

60 
61 


- ABSTRACT - 

WEIHTY  COMPUTES  COMPLEX  WEIGHTS  W(P.H)  SUCH  THAT  THE 
REAL  PART  OF  THE  SUM  OVER  ALL  SPECIFIED  P.H  COMBIIA- 
TIOIS  OF  COIJG(W(P,H))*X(P.T+H)  IS  AS  CLOSE  AS  POS¬ 
SIBLE  TO  Y(T)  II  THE  LEAST-SQUARES  SEISE.  X(P,T)  RE- 
PRESEITS  THE  PTH  COMPOIEIT  OF  THE  COMPLEX  REFEREICE 
SERIES  X  AT  TIME  T.  Y(T)  REPRESEITS  THE  VALUE  AT  TIME 
T  OF  THE  SERIES  TO  BE  PREDICTED.  THE  P  AID  H  VALUES 
TO  BE  USED  ARE  GIVEI  BY  ARRAYS  JP  AID  H,  AID  THE  P.H 
COMBIIATIOIS  ARE  SPECIFIED  BY  ARRAYS  IP  AID  IH  -  FOR 
EACH  I  SUCH  THAT  0  .LT.  I  .LE.  IPHGPl,  ALL  JP(J) 

SUCH  THAT  IP(l-l)  -LT.  J  .LE.  IP(I)  ARE  COMBIIED  WITH 
ALL  H(I)  SUCH  THAT  IH(I-l)  .LT.  I  .LE.  IH(I)  .  THE  OUT¬ 
PUT  ARRAY  PHWTS  COISISTS  OF  P,  H.  W(P,H)  MERGED 
(I.E.  A  4  REAL  COMPOIEIT  SERIES). 


—STATISTICS— 


LAIGUAGE 

EQUIPMEIT 

STORAGE 


UCSD  FORTRAI  63 
10  SPECIAL  REQUIREMEITS 

484  WORDS  FOR  THIS  PROGRAMME  *  436  WORDS  FOR 
ASSOCIATED  SUBPROGRAMMES  (MAVDUB.ISMI.IITCH)  + 

1018  WORDS  COMMOl  +  SPACE  FOR  ARRAYS  X,  Y,  JP,  H, 
IP,  IH,  XXMl,  PHWTS  (I.E.  2*KX+KY+KP+KH+2*IPHGP1+ 
KMl+KPHWTS  WORDS) 


SPEED 
AUTHOR 
LAST  MOD 
CATAGORIES 
STATUS 


MARK  WIMBUSH 
MARK  WIMBUSH 


JUL  1970 
APR  1972 


LIBRARY  ROUTIIES  USED-  MAVDUB,  ISMI 

SYSTEM  ROUTIIES  USED  -  IROUID,  XIITF,  FLOATF,  Q8QIIG0T.  Q8QEIG0T. 
QBQGOTTY 


- USAGE - 

SAMPLE  CALL 

J  =  WEIHTY(X,Y,JP,KP,H,KH, IP. IH, IPHGPl, XXMl, XXM,  PHWTS .KPHWTS) 


XXN1(1),XXN(1)  SHOULD  BE  EQUIVALEICED  PRIOR  TO 
CALLIIG  WEIHTY 

DIMEISIOI  OF  REFEREICE  SERIES  X  IS 
LIMP*IIT(1.6+(EX-SX)/D)  (COMPLEX) 

DIMEISIOI  OF  DATA  SERIES  Y  IS  KY=IIT(1 . 5+(EY-SY)/D) 
DIMEISIOI  OF  WORKIIG  STORAGE  ARRAY  XXMl  IS 
4*IPH*(IPB-M).  WHERE  IPH  IS  THE  TOTAL  HUMBER 
OF  P.H  COMBIIATIOIS  SPECIFIED 
DIMEISIOI  OF  ARRAY  PHWTS  IS  KPHWTS=4*IPH 
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62 

C 

63 

C 

64 

C 

IIPUTS 

65 

C 

66 

C 

X(I) 

COMPLEX  MERGED  REFEREICE  SERIES  01  WHICH  THE  PREOICTIOI 

67 

C 

WEIGHTS  ARE  TO  BE  BASED 

68 

C 

69 

C 

Yd) 

SERIES  OF  OBSEPVATIOIS  FOR  WHICH  PREOICTIOI  WEIGHTS  ARE 

70 

C 

TO  BE  FOUID  (ZERO  MEAI) 

71 

c 

72 

c 

JPCI) 

ARRAY  OF  P  VALUES  (X  COMPOIEIT  lUMBERS)  TO  BE  USED 

73 

c 

II  FORMIIG  THE  PREOICTIOI  WEIGHTS 

74 

c 

75 

c 

KP 

DIMEISIOI  OF  ARRAY  JP 

76 

c 

77 

c 

Hd) 

ARRAY  OF  H  VALUES  (X  TIME  LEADS)  TO  BE  USED  II  FORMIIG 

78 

c 

THE  PREOICTIOI  WEIGHTS 

79 

c 

80 

c 

KH 

DIMEISIOI  OF  ARRAY  H 

81 

c 

82 

c 

■Pd) 

m 

II 

o 

83 

c 

■PCI  .GT.  1)  IS  THE  HUMBER  OF  THE  LAST  TERM  II  THE 

84 

c 

d-DTH  GROUP  OF  ARRAY  JP 

85 

c 

86 

c 

IHCI) 

■H(l)  =  0 

87 

c 

■Hd  .GT.  1)  IS  THE  lUMBER  OF  THE  LAST  TERM  II  TEE 

88 

c 

d-l)TH  GROUP  OF  ARRAY  H 

89 

c 

90 

c 

IPHGPl 

DIMEISIOI  OF  ARRAY  IP  AID  OF  ARRAY  IH 

91 

c 

92 

c 

XXNl 

AI  ARRAY  OF  WORKIIG  STORAGE  HEEDED  FOR  MATRIX  OPERATIOIS 

93 

c 

94 

c 

- COMMOI  /WAITER/ 

95 

c 

96 

c 

IIISHL 

IIISHL  .IE.  0  IIDICATES  THAT  THIS  IS  THE  IlITIAL  CALL 

97 

c 

II  THIS  COMPUTATIOI 

98 

c 

IIISHL  .EQ.  0  IIDICATES  THAT  THIS  IS  HOT  THE  IlITIAL 

99 

c 

CALL 

100 

c 

101 

c 

IFIIAL 

IFIIAL  .IE.  0  IIDICATES  THAT  THE  CALL  IS  THE  FIIAL  CALL 

102 

c 

II  THIS  COMPUTATIOI. 

103 

c 

IFIIAL  >  0  IIDICATES  THAT  THE  CALL  IS  HOT  THE  FIIAL  CALL 

104 

c 

105 

c 

sx 

START  TIME  OF  SERIES  X 

106 

c 

107 

c 

EX 

EID  TIME  OF  SERIES  X 

108 

c 

109 

c 

SY 

START  TIME  OF  SERIES  Y 

no 

c 

111 

c 

EY 

EID  TIME  OF  SERIES  Y 

112 

c 

113 

c 

D 

UlIFORM  TIME  IICREMEIT  OF  SERIES  X  AID  SERIES  Y 

114 

c 

115 

c 

LIMP 

■UMBER  OF  COMPLEX  COMPOIEITS  MERGED  II  SERIES  X 
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116 

117 

118 

119 

120 
121 
122 

123 

124 

125 

126 

127 

128 

129 

130 

131 

132 

133 

134 
136 

136 

137 

138 

139 

140 

141 

142 

143 

144 

145 

146 

147 

148 

149 

150 
161 

152 

153 

154 
156 

156 

157 

158 

159 

160 
161 
162 

163 

164 
166 
166 

167 

168 
169 


C 

C 

C  OUTPUTS 
C 

C  PHWTSTl)  ARRAY  COISISTIIG  OF  P  VALUE.  H  VALUE.  COMPLEX  PREDIC- 
C  TIOi  WEIGHT  W(P.H)  MERGED  TOGETHER  (I.E.  4  REAL  COMPOI- 

C  EITS  MERGED) 

C 

C  KPHWTS  DIMEISIOi  OF  ARRAY  PHWTS 


C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

n 

c 

c 

c 

c 

c 

c 

c 

c 

c 


WEIHTY  =0.  IF  10  ERRORS 

=1.  IF  A  P  VALUE  IS  GREATER  THAI  THE  HUMBER  OF  COM- 
POIEITS  II  THE  X  SERIES. 

-1.  IF  A  VALUE  II  THE  ARRAY  IP  EXCEEDS  THE  DIMEISIOI 
OF  ARRAY  JP 

=3.  IF  VALUES  II  ARE  HOT  II  IICREASIIG  ORDER 

=4.  IF  A  VALUE  II  ARRAY  IH  EXCEEDS  THE  DIMEISIOI 
UF  ARRAY  H 

=5.  IF  VALUES  II  IH  ARE  HOT  II  IICREASIIG  ORDER 

=6.  X  SERIES  STARTS  TOO  LATE  TO  ACCOMODATE  MIIIMUM  LEAD 

=7.  SY  IS  lOT  OIE  OF  THE  TIMES  OF  SERIES  X 

=8.  X  SERIES  EIDS  TOO  EARLY  TO  ACCOMODATE  MAXIMUM  LEAD 

=9.  IF  10  P  VALUES  ARE  GIVEI 

=10.  IF  10  H  VALUES  ARE  GIVEI 

=11.  IF  IP(1)  .LT.  0 

=12.  IF  IH(1)  .LT.  0 

=13.  IF  THERE  ARE  10  P.H  COMBIIATIOIS .  THAT  IS 
IPHGPl  .LT.  2 

=14.  IF  (TIME  IITERVAL)/(EID  TIME-START  TIME)  IS 
lEGATIVE  FOR  SERIES  Y 

=16.  IF  (TIME  IITERVAL)/(EID  TIME-START  TIME)  IS 
lEGATIVE  FOR  SERIES  X 
=16.  IF  MATRIX  IS  SIIGULAR 


C 


C 

C  EXAMPLES 


C 

C  PROGRAM  FOLLOWS  BELOW 
C 

COMMOl  /WAITER/  IIISHL.IFIIAL.SX.EX.SY.EY.D.LIMP 
COMMOl  /WEIGHT/  JXY, IPH.IPHl.KV, TOT, SIGMA, JI.JK.JD 
COMMOl  /WORKII/  JH(1T6).JPH(125).XX1(250).YXV1(6''0) 

DOUBLE  PRECISIOI  XXN.YXV 
COMPLEX  X 

DIMEISIOI  X(l) ,Y(1) . JP(KP) .H(KH) .IP(IPHGPl) ,IH(IPHGP1) . 

1  XXM1(1),XXM(1),YXV(260).PHWTS(1),PPHG(125)  !!! 

C -  (SEE  MOTE*  ABOVE  FOR  TRUE  DIMEISIOIS  OF  X.Y.XXMl .PHWTS) 

EDttTVALEICE  (''XVl(l)  .YXV(l))  ,  (PPHG(l)  .  JH(  1)) 


DATA  DELT0,DEL0/0.8,0.8/ 
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170  tfEIHTY=0. 

171  IF(SI.Eq.EX)  GO  TO  10 

172  IF(D/(EX-SX) .GT.O.)  GO  TO  10 

173  WEIHTY=16. 

174  RETURI 

175  10  IFCSY.IE  E'')  GO  TO  20 

176  KY=1 

177  GO  TO  41. 

178  20  DDEMSY=D/(EY-SY) 

179  IF(DDE>.3Y.GT.0.)  GO  TO  30 

180  HEIHTY-14. 

181  RETURN 

182  30  KY=I>T(1 ./DDEMSY+1.6) 

183  C  SKI’’  lEXT  SECTIOI  IF  HOT  IIITIIL  CAL^ 

184  40  IFCIIISHL.EQ.O)  GO  TO  100 

186  c\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ 

186  IF(KP.LT.l)  WEiH'nr=9. 

187  IF(KH.LT.l)  WEIHTY=10. 

188  IF(1P(1) .LT.O)  WEIHTY=11. 

189  IF(IH(1) .LT.O)  WEIHTY=12. 

190  IF(IPHGP1.LT.2)  WEIHTY=13. 

191  IF(WEIHTY.fE.O.)  RETURI 

192  c\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ 

193  DO  60  K=1,KP 

194  IF(JPCK) .GT.LIKP)  tfEIHTY=l. 

196  50  COITIIUE 

196  cWWWWWWW 

197  HMII=H(1) 

198  HMAXsH(l) 

199  DO  60  X=1,XH 

200  JH(X)=IROUID(H(X)/D) 

201  IF(H(X) .LT.RMII)  HMII=H(R) 

202  IF(H(X) .GT.HHAX)  HMAX=H(X) 

203  60  COITIIUE 

204  cWWWWWWW 

206  IPH=0 

206  C  FOR  EACH  P.H  COMBIIATIOI ,  COMPUTE  OFFSET  JPH  II  SERIES  X 

207  DO  70  IPHGP1=2,IPHGP1 

208  IP1=IP(IPHGP1-1)+1 

209  IP2=IP(IPHGP1) 

210  IF(IP2.GT.KP)  WEIHTY=2. 

211  IF(IP2.LT.IP1)  WEIHTY=3. 

212  IH1=IH(IPHGP1-1)+1 

213  IH2=IH(IPHGP1) 

214  IFvSH2.GT.KH)  WEIHTY=4. 

216  IF(IH2.LT.IB1)  WEIHTY=6. 

216  DO  70  IP=IP1,IP2 

217  JPIP=JP(IP) 

218  DO  70  IH=IH1,IH2 

219  IPH=IPH-fl 

220  70  JPH(IPH)=JPIP+JH(IH)*LIMP 

221  cWWWWWWWNWWWWWWWW 

222  IPH1=2*IPH 

223  XPHUTS=2*IPH1 


132 


224 

225 

226 

227 

228 

229 

230 

231 

232 

233 

234 

235 

236 

237 

238 

239 

240 

241 

242 

243 

244 

245 

246 

247 

248 

249 

250 

251 

252 

253 

254 

255 

256 

257 

258 

259 

260 
261 
262 

263 

264 

265 

266 

267 

268 

269 

270 

271 

272 

273 

274 
276 

276 

277 


c\\\\\\\\\\\\\\\\\\\ 

100  XY=SY-SX 

IF(-XY-HMII.GT.DELTO)  WEIHTY=6. 

XY=XY/D 

JXY=IROUID(XY) 

IF{ABS(XY-FLOAT(JXY)) .GT.DELO)  MEIHTY=7. 
IF(EY+HMAX-EX.GT.DELTO)  WEIHTY=8. 

IF(WEIHTY.IE.O.)  RETORf 
JXY=JXY*LIMP 

C  FORM  MATRIX  M  (UPPER  TRIAIGULAR)  AID  VECTOR  V  (BOTH  II 

C  DOUBLE  PRECISIOI) 

CALL  NAVDUB(Y.X,  XXN) 

C  RETURI  IF  lOT  FIIAL  CALL 

IF(IFIIAL.EQ.O)  RETURI 

cwwwwwwwwwwwwww 

C  PACK  K  AID  V  II  SIIGLE  PRECISIOI  FORM 

IJM1=IPH1+1 

IJM2=IPH 

DO  120  JPH1=1.IPH1 
DO  110  IPH1=1,JPH1 
IJM1=IJM1+1 
IJM2=IJM2+1 

XXM1(IJM1)=SIGL(XXM(IJM2))/T0T 
110  continu« 

YXV 1 ( JPH 1 ) =SIGL ( YXV ( JPH 1 ) ) /TOT 
120  continue 

c\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ 

SIGMAaSIGMA/TOT 

C  SOLVE  EQUATIOI  FOR  VECTOR  OF  WEIGHTS  W 

IFdSMKXXMl)  .lE.O)  GO  TO  160 
P=0. 

1=0 

IPHG=0 

DO  150  IPHGP1=2,IPHGP1 
IPHG=IPHG+1 
IP1=IP(IPHGP1-1)+1 
IP2=IP(IPHGP1) 

IH1=IH(IPHGP1-1)>1 

IH2=IB(IPHGP1) 

PRIIT  1000,  IPHG,(H(IH).  1B=IH1.IH2} 

PRUT  1100 
PG=0. 

DO  140  IP=IP1,IP2 
PPG=0. 

11=1+1 

DO  130  IH=IH1,IH2 

PHWTS (4*1+1) =FLO AT( JP ( IP) ) 

PHWTS(4*I+2)»H(IH) 

PHWTS(4*I+3)=YXV1 (2*1+201) 
PHWTS(4*I+4)=YXVl(2*I+202) 

1=1+1 
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278  PPHG(I)=YXVl(2*I-l)*YIVl(2*I+199)+YXVl(2*I)*yXVl (2*1+200) 

279  130  PPG=PPG+PPHG(I) 

280  PRUT  1200,  JP(IP)  .PPG,  (PPHG(IH)  .  IH=I1.I) 

281  140  PG=PG+PPG 

282  PRUT  13007  PG.IPHG 

283  150  P=P+PG 

284 

285  RESIDV=SIGNA-P 

286  PRUT  1400,  SIGMA, P,RESIDV 

287  1=4*1 

288  PRUT  1500,  (PHWTS(K),  K=1,I) 

289  PRUT  1600 

290  RETURI 

291  160  HEIHTY=16. 

292  RETURI 

293 

294  cWWWWWW 


295 

296  1000  FORMAT  (40H0  PREDICTED  VARIAICE  MATRIX  OF  P,H  GROUP, 13, 3H  IS/lHO, 

297  15X,12HR0W  SUM  H,F11 .4,7F12.4/(17X,8F12.4)) 

298  1100  FORMAT  (3H  P) 

299  1200  FORMAT  (1X,I2,2E13.4,7E12.4/(17X,8E12.4)) 

300  1300  FORMAT  (6X,11H - /4X,E12.4,42H  IS  TOTAL  PREDICTED  VARIAIC 

301  IE  OF  P,H  GROUP, 13/) 

302  1400  FORMAT  (1H0,6X,21HREC0R0E0  VARIAICE  =,E14.6/6X,21HPREDICTED  VARI 

303  lAICE  =,E14.6/6X,21HRESI0UAL  VARIAICE  =,E14.6//) 

304  1500  FORMAT  (21H0  GEIERATED  SERIES  IS/3H0  P,6X,1HH,8X, 

305  +  26HREAL(WEIGHT)  1IMAG(WE1GHT)/(1X,F2.0,F12.4,2E14.4)  ) 

306  1600  FORMAT  (IHO//) 

307 

308  EID 

1  FUlCTIOl  SPOITY(X,  PHWTS , KPHWTS ,  JP,  IP,IPGP1,  YPRED,KY) 


2  C 

3  C 

4  C  TITLE  -  SPOITY  =  RESPOISE,  TYDE 

5  C  GEIERATES  TIDE  SERIES  FROM  PREDICTIOI  WEIGHTS 

6  C 

7  C 

8  C  - ABSTRACT - 

9  C 

10  C  SPOITY  FORMS  TIME  SERIES  Y(P,T)  =  SUM  OVER  H  OF 

11  C  COIJG(W(P,H))*X(P,T+H).  W(P,H)  REPRESEITS  THE  COMPLEX 

12  C  WEIGHT  ASSOCIATED  WITH  THE  PTH  COMPOIEIT  OF  THE  REFEREICE 

13  C  SERIES  AT  LEAD  H.  W(P,H)  IS  OBTAIIED  FROM  IIPUT  SERIES 

14  C  PHWTS  COISISTIIG  OF  P,  H,  W(P.H)  MERGED  (I.E.  A  4 

15  C  REAL  COMPOIEIT  SERIES) .  X(P,T)  REPRESEITS  THE  PTH 

16  C  COMPOIEIT  OF  THE  COMPLEX  REFEREICE  SERIES  X  AT  TIME  T. 

17  C  IF  KOMPLX  IS  ZERO  OILY  THE  REAL  PART  OF  Y(P,T)  IS  RE¬ 
IS  C  TAIIED.  THE  P  VLAUES  TO  BE  USED  ARE  SPECIFIED  BY  ARRAY 

19  C  JP.  UILESS  JP(1)  IS  ZERO,  THE  OILY  P  VAULES  USED  ARE 

20  C  THOSE  GIVEI  BY  JP(1),  JP(2) . JP(I)  WHERE 

21  C  I  =  IP(IPGPl),  AID  THE  OUTPUT  SERIES  YPRED(IPGP ,T) 

22  C  COISISTS  OF  THE  MERGED  COMPOIEIT  SUNS  Y(JP(I),T) 

23  C  +  T(JP(I+1),T)  +  . . .+  Y(JP(IP),T)  WHERE  I=IP(IPGP)+1 


134 


24 

C 

AID  IP=IP(IPGP+1)  AID  IPGP=1,2 . (IPGPl-l).  IF  JP(l) 

2S 

C 

IS  ZERO  THEI  ALL  P  VALUES  II  PHVTS  ARE  USED  AID 

26 

C 

YPRED(T)  IS  THE  SIIGLE  (REAL  OR  COMPLEX)  COMPOIEIT 

27 

r» 

SERIES  COISrSTII'!  OF  THE  SUM  OF  x(y.r)  OVER  ALL  P. 

28 

c 

~ 

29 

c 

30 

c 

—STATISTICS— 

31 

c 

32 

c 

LAIGUAGE  - 

UCSD  FORTRAI  63 

33 

c 

EQUIPMEIT  - 

10  SPECIFIED  REQUIREMEITS 

34 

c 

STORAGE 

261  WORDS  FOR  THE  PROGRAM  -t-  1008  WORDS  COMNOI  (480  OF 

36 

c 

WHICH  ARE  DUMMY)  +  SPACE  FOR  ARRAYS  X.  PHWTS,  JP. 

36 

c 

IP,  YPRED  (I.E.  2*KX+KPHWTS+KP+IPGP1+K12*KY  WORDS,  WHERE 

37 

c 

K12=l  OR  2  ACCORDIIG  AS  KOMPLX  IS  ZERO  OR  lOI-ZERO) 

38 

c 

SPEED 

39 

c 

AUTHOR 

MARX  WIMBUSH  IGPP  AUG  1970 

40 

c 

LAST  MOO 

MARK  WIMBUSH  lOVA  APR  1972 

41 

c 

CATAGORIES  - 

42 

c 

STATUS 

43 

c 

LIBRARY  ROUTIIES  USED  -  lOIE 

44 

c 

SYSTEM  ROUTIIES  USED  -  IROUID,  XIITF,  AIMAG,  FLOAT? 

46 

c 

46 

c 

47 

c 

- USAGE - 

48 

c 

49 

c 

SAMPLE  CALL 

60 

c 

J  s  SPOITY(X,PHWTS,KPHVrS,JP,iP,IPGPl,  YPRED.KY) 

61 

c 

62 

c 

lOTE 

DIMEISIOI  OF  REFEREICE  SERIES  X  IS 

53 

c 

LIMP*IIT(1.6+(EX-SX)/D)  (COMPLEX) 

64 

c 

- 

DIMEISIOI  OF  COMPOIEIT  lUNBER  SERIES  JP  IS  IP(IPGPl) 

56 

c 

- 

DIMEISIOI  OF  PREDICTED  SERIES  YPRED  IS 

56 

c 

KY=IIT(1.5+(EY-SY)/D)  (YPRED  COISIDERED  COMPLEX 

67 

c 

UILESS  K0MPLX=0) 

68 

c 

69 

c 

60 

c 

IIPUTS 

61 

c 

62 

c 

X(I) 

COMPLEX  MERGED  REFEREICE  SERIES  01  WHICH  THE  PREDICTIOI 

63 

c 

WEIGHTS  ARE  BASED 

64 

c 

66 

c 

PHWTS(I) 

ARRAY  COISISTIIG  OF  P  VALUE,  B  VALUE,  COMPLEX  PRE¬ 

66 

c 

DICTIOI  WEIGHT  W(P,H)  MERGED  TOGETHER  (I.E.  4  REAL 

67 

c 

COMPOIEITS  MERGED) 

68 

c 

69 

c 

KPHHTS 

DIMEISIOI  OF  ARRAY  PHWTS  (SHOULD  BE  4*IPH  WHERE  IPH 

70 

c 

IS  THE  TOTAL  lUMBER  OF  P,H  CONBIIATIOIS  II  PHWTS) 

71 

c 

72 

c 

JP(I) 

ARRAY  OF  P  VALUES  (X  COMPOIEIT  lUMBERS)  TO  BE  USED  II 

73 

c 

FORMIIG  THE  PREDICTED  TIDE 

74 

c 

76 

c 

IP(I) 

■P(l)  =  0 

76 

c 

IP (I  .GT.  1)  IS  THE  lUMBER  OF  THE  LAST  TERM  II  THE 

77 

c 

(I-l)TH  GROUP  OF  ARRAY  JP 
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78 

C 

79 

C 

IPGPl 

DINEISIOI  OF  ARRAY  IP 

80 

C 

81 

C 

- COMMOI  /RESTOR/ 

82 

C 

83 

C 

IIISHL 

IIISHL  .IE.  0  IIDICATES  THAT  THE  CALL  IS  THE  IIITIAL 

84 

C 

CALL  II  THIS  COMPUTATIOI 

85 

C 

IIISHL  .EQ.  0  IIDICATES  THAT  THE  CALL  IS  lOT  THE 

86 

C 

IIITIAL  CALL 

87 

C 

88 

C 

sx 

START  TINE  OF  SERIES  X 

89 

C 

90 

C 

EX 

EID  TINE  OF  SERIES  X 

91 

C 

92 

C 

SY 

START  TIME  OF  SERIES  YPRED 

93 

C 

94 

C 

EY 

EID  TINE  OF  SERIES  YPRED 

95 

C 

96 

C 

D 

UIIFORN  TINE  IICRENEIT  OF  SERIES  X  AID  SERIES  YPRED 

97 

C 

98 

C 

LIMP 

lUNBER  OF  COMPLEX  CONPOIEITS  MERGED  II  SERIES  X 

99 

C 

100 

C 

KOMPLX 

KOMPLX  .IE.  0  IIDICATES  THAT  THE  COMPLEX  PREDICTED 

101 

C 

SERIES  IS  REQUIRED 

102 

C 

KOMPLX  .EQ.  0  IIDICATES  THAT  OILY  THE  REAL  PART  OF  THE 

103 

C 

PREDICTED  SERIES  IS  TO  BE  RETAIIED 

104 

c 

105 

c 

106 

c 

OUTPUTS 

107 

c 

108 

c 

YPRED(I) 

TINE  SERIES  OF  TIDE  PREDICTIOIS.  HAVIIG  IPGPl-1  MERGED 

109 

c 

(REAL  OR  COMPLEX)  CONPOIEITS  IF  JP(1)  .IE.  0,  OTHERWISE 

110 

c 

HAVIIG  OIE  (REAL  OR  COMPLEX)  CONPOIEIT 

111 

c 

112 

c 

KY 

DINEISIOI  OF  SERIES  YPRED  (YPRED  COISIDERED  COMPLEX 

113 

c 

UILESS  K0NPLX=0) 

114 

c 

115 

c 

SPOITY 

=0.  IF  IIPUT  ITEMS  HAVE  VALID  VALUES 

116 

c 

=1.  IF  VALUES  II  IP  ARE  lOT  II  IICREASIIG  ORDER 

117 

c 

=2.  IF  THE  P«S  GIVEI  II  ARRAY  JP  DO  lOT  NATCH  THE 

118 

c 

P«S  GIVEI  II  SERIES  PBVTS 

119 

c 

=3.  X  SERIES  STARTS  TOO  LATE  TO  ACCOMODATE  MIIINUN  LEAD 

120 

c 

>4.  IF  ST  IS  lOT  OIE  OF  THE  TINES  OF  SERIES  X 

121 

c 

=S.  X  SERIES  EIDS  TOO  EARLY  TO  ACCOMODATE  MAXIMUM  LEAD 

122 

c 

*6.  IF  IP(1)  .LT.  0 

123 

c 

=7.  IF  THERE  ARE  10  P  GROUPS,  THAT  IS  IPGPl  .LT.  2 

124 

c 

=8.  IF  KPHWTS  IIVALID  (.LE.O  OR  lOT  A  MULTIPLE  OF  4) 

125 

c 

=9.  IF  (TIME  INTERVAL) /(EID  TIME  -  START  TIME)  IS 

126 

c 

NEGATIVE  FOR  SERIES  YPRED 

127 

c 

128 

c 

129 

c 

EXAMPLES 

130 

c 

131 

c 

136 


132 

133 

134 
136 

136 

137 

138 

139 

140 

141 

142 

143 

144 
146 

146 

147 

148 

149 
160 
161 
162 

163 

164 
166 
166 

167 

168 
169 
160 
161 
162 

163 

164 
166 
166 

167 

168 

169 

170 

171 

172 

173 

174 
176 

176 

177 

178 

179 

180 
181 
182 

183 

184 
186 


C  PROGRAM  FOLLOWS  BELOW 
C 

CONMOl  /RESTOR/  IIISHL.SX.EI.SY.EY.D.LINP.KONPLX 
COMMOI  /WORKII/  RSVP(600).JP0PHW(126),JPHW(126),JPH(126),MPH(126) 
c\\\\\\\\W\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ 
COMPLEX  X 

DIMEISIOI  X ( 1) , PHWTS (KPHWTS) . JP( 1) , IP ( IPGP 1 ) . YPRED ( 1 ) 

C  (SEE  MOTE*  ABOVE  FOR  TRUE  DIMEISIOIS  OF  X.JP, YPRED) 

EQUIVALEICE  ( JPIP,RSVP(1)) , (J1Y.RSVP(2)) , { J ,RSVP(3)) . 

1  ( lie , RSVP (4) ) . (LP . RSVP (6) ) , (MPH 1 . RSVP (6) ) , (MPH2 , RSVP (7 ) ) , 

2  ( IPGI , RSVP ( 8 ) ) , ( IPGIIT , RSVP (9 ) ) . (IPH , RSVP ( 10 ) ) , ( IPHT . RS VP ( 1 1 ) ) . 

3  (■PHW,RSVP(12)),(IP1.RSVP(13)).(IP2,RSVP(14)).(DDEMSY,RSVP(1S)), 

4  (DD1E3,RSVP(16)).(HMAX.RSVP(17)).(HMII,RSVP(18)).(XY.RSVP(19)) 
DATA  DELT0,DEL0/0.8,0.8/ 

SP0ITY=0 . 

IF(SY.IE.EY)  GO  TO  10 
KY=1 

GO  TO  30 

10  DDEMSY=D/(EY-SY) 

IF(DDEMSY.GT.O.)  GO  TO  20 
SP0ITY=9. 

RETURI 

20  KY=1IT(1./DDEMSY+1.6) 

C  SKIP  lEXT  SECTIOI  IF  MOT  lilTIAL  CALL 

30  IF(IIISHL.EQ.O)  GO  TO  100 
IF{JP(l).IE.O)  GO  TO  34 
■P(1)=0 
■P(2)=l 
IPGP 1=2 

34  IF(IP(l).LT.O)  SP0ITY=6. 

IF (IPGP1.lt. 2)  SP0ITY=7. 

IF(M0D(KPHWTS-3 ,4)-l . IE . 0)  SP0ITY=8 . 

IF(SPOITY.IE.O.)  RETURI 

IPHW=0 

IPH=0 

MPH(1)=0 

HMII=PHWTS(2) 

HMAX=PHWTS(2) 

DO  40  IPH¥TS=1, KPHWTS, 4 

IF(PHWTS(IPHWTS+1) .LT.HMII)  HMII=PHWTS(IPHWTS+1) 
IF(PHWTS(IPHWTS+1) .GT.HMAX)  HMAX=PHWTS(IPHWTS+1) 

IPHW=IPHW4^1 

C -  (JPOPHW(I)  IS  THE  ICTH  P  II  MERGED  IIPUT  SERIES  PHWTS) 

40  JPOPHW(IPHW)=IIT(PHWTS(IPHWTS)) 

C -  FOR  EACH  HEEDED  P.H  COMBIIATIOI  COMPUTE  OFFSET  JPH  II  SERIES  X 

DO  80  IPGP1=2,IPGP1 
IP1=IP(IPGP1-1)+1 
IP2=HP(IPGP1) 

IF(IP2.LT.IP1)  SP0ITY=1. 

DO  70  IP=IP1,IP2 
IPHT=IPH 
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186  JPIP=JP(IP) 

187  DO  50  IPHW=1,IPH¥ 

188  IF{JPOPH¥(IPHH).IE. JPIP.ilD. JP(l).IE.O)  GO  TO  50 

189  IPH=IPJ-fl 

190  C -  (JPHW(I)  IS  lUMBER  II  THE  MERGED  liPUT  SERIES  PHWTS 

191  C -  OF  THE  lOTH  SELECTED  P.H.W  GROUP) 

192  JPHW(IPH)=IPHW 

193  JPH(IPH)=JP0PHW(IPHW)+IR0UID{PHWTS(4*IPHW-2)/D)*LIMP 

194  50  COITIIUE 

195  IF(IPHT.IE.IPH)  GO  TO  70 

196  SP0ITY=2. 

197  70  COITIIUE 

198 

199  C -  (MPH(I+1)  IS  THE  SELECTIOI  lUMBER  OF  THE  LAST  P.H.H 

200  C -  GROUP  ASSOCIATED  WITH  THE  LAST  P  II  THE  I*TH  GROUP 

201  C -  II  THE  STATEMEIT  LIST  (MPH(1)=0)  ) 

202 

203  MPH(IPGP1)=IPH 

204  80  continua 

205 

206  IIC*1 

207  IF(KOMPLX.IE.O)  IIC=2 

208  IPGI=(IPGP1-1)*IIC 

209  100  XY=SY-SX 

210  IF(-XY-HMII.GT.DELTO)  SP0ITY*3. 

211  XY»XY/D 

212  JXY*IROUID(XY) 

213  IF(ABS(XY-FLOAT(JXY)).GT.DELO)  SP0ITY=4. 

214  IF(EY+HMAX-EX.GT.DELTO)  SPOITYsS. 

215  IFCSPOITY.IE.O.)  RETURI 

216  JXY=JXY*LIMP 

217  IPGIIT=IPGI*KY 

218  C  SET  TO  ZERO  ARRAY  YPRED 

219 

220  DO  110  IT=1,IPGIIT 

221  YPRED(IT)=0. 

222  110  continua 

223 

224  LP=1 

225 

226  C -  CONPOTB  PREDICTED  SERIES  AID  STORE  II  ARRAY  YPRED  II  MERGED 

227  C -  FORM 

228 

229  DO  140  IT=1,KY 

230  DO  130  IPGP1=2.IPGP1 

231  MPH1=MPH(IPGP1-1)+1 

232  MPH2-MPH(IPGP1) 

233  DO  120  IPH=MP81,MPH2 

234  J*JXY+JPH(IPH) 

235  IPHW^JPHVdPH) 

236  YPRED(LP)=YPRED(LP) 

237  1  +PHWTS(4*IPHW-1)*REALCX(J))+PH¥TS(4*IPHW)*AIMAG(X(J)) 

238  IF(KOMPLX.IE.O)  YPRED(LP+1)=YPRED(LP+1) 

239  1  +PHWTS(4*IPHW-1)*AIMAG(X(J))-PHWTS(4*IPHW)*REAL(X(J)) 
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240 

120 

COITIIUE 

241 

130 

LP=LP+IIC 

242 

140 

JXY=JXY+LIMP 

243 

244 

RETURI 

245 

246 

EID 

1  !  SFOR.IS  TIDE. TAON, TIDE. TADM 

2  FUICTIOI  TADM(PHW,LI.  ORAY.LO.  FS.DELF.CKPIT,  KEEP) 

3  DIMEISIOI  PHW(LI),01UY(L0) 

4  DIMEISIOI  FREq(49) 

5  REAL*8  KSYNB(50) 

6  C 

7  C  DARUII  SYMBOLS  AID  FREQUEICIES  STORED  II  ORDER  OF  ASCEIDIIG 

8  C  SIGIIFICAICE. 

9  C 

10  DATA  KSYMB  /2HS8,  2BS6.  2BS4.  2BS3.  4B2SM2.  2BS1.  3BMSF,  3BSSA, 

11  1  6B2MSI8,  4BMSI6.  4B2SM6.  3BMK4.  3BS03,  3BSK3.  4BMIS2,  3B2Q1, 

12  2  3BPI1,  6BSIGMA1,  3BR01.  3B001.  2BMF,  2BSA.  6B2(MS)8.  4B2MI6. 

13  3  3BMI4,  4B2MX3,  3B2I2.  2BT2.  2BL2.  3BMU2.  2BM1.  2BJ1,  4B3MS8, 

14  4  4B2MS6,  3BMS4,  3BMK3,  3BIU2.  2Bqi.  2BM8,  2BM6,  2BM4,  2BM3,  2BX2. 

15  S  2BI2,  2BP1,  2B01,  2BS2.  2BK1.  2BM2,  IB  / 

16  C 

17  DATA  FREq  /  8.0,  6.0,  4.0,  3.0,  2.067726386,  1.0,  .0677263854, 

18  1  .0064758186,  7.760629198,  5.828266683,  6.932273616,  3.937749433, 

19  2  2.929636706,  3.002737909,  1.828255683,  .8569524129,  .9946243121, 

20  3  .8618093199.  .8981009661,  1.076940113,  .073202204,  .0027379093, 

21  4  7.86464722^  6.  '60529198,  3.828256683,  2.86180932,  1.859690322, 

22  6  1.997262221,  x. 968666261,  1.864647229,  .9664462631,  1.039029556, 

23  6  7.796820844,  6.864647229,  3.932273616,  2.936011624,  1.900838875, 

24  7  .8932440691,  7.729094458,  5.796820844,  3.864647229,  2.898410422, 

26  8  2.006476819,  1.896981968,  .9972620907,  .9296367063,  2.0, 

26  9  1.002737909,  1.932273616/ 

27  C 

28  1  F0RMAT(F6.4) 

29  2  F0RMAT(1B0,F10.3,F10.4,F11.6,F13.6,F12.6,F13.6,F10.3,2(5X,A7, 

30  1  8X)) 

31  3  F0RNAT(1B0,8X,17BF  R  E  q  U  E  I  C  Y,9X, IB*, 12X, 19BA  DMITTAIC 

32  1  E,14X,1B*,8X,21BT  IDAL  LIIES/ 

33  2  44I,28BtlAM0BS  LEADS  $IAMREF  BY  DEG/ 

34  3  6X,37KCPY  CPM  CPD  •  REAL,8X ,67BIMAG  *  AMPLI 

36  4TUDE  DEG  *  MOST  STGIIFICAIT  •  MOST  CEITRAL/ 

36  6  3SX,1B*,22X,1B*,22X,1B*.13X,8BCPD  *,12X,3BCPD) 

37  4  FORMAT(IRO) 

38  C 

39  C  LO  IS  LEIGTB  OF  ORAY 

40  C  LI  IS  LEIGTB  OF  PBV 

41  C  TBE  LEIGTB  OF  PBV  SBOULD  BE  A  MULTIPLE  OF  4 

42  TADM  s  1. 

43  IF(M0D(LI,4)  .IE.  0)  RETURI 

44  C 

46  PRUT  3 

46  PI  =  -3.1415926636 

47  F  *  FS 
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48  C 

49  DO  3000  ■1=1.L0,2 

50  12=11  +  1 

51  OREAL  =  0. 

52  OIMAG  =0. 

53  C 

54  DO  2000  K1=1,LI,4 

55  K2=K1  +  1 

56  K3  =  K2  +  1 

57  K4  =  K3  +  1 

58  IF(PHW(K1)  .IE.  CMPIT)  GO  TO  2000 

59  ALPH  =  PHW(K2)  *  PI  ♦  F  /  12. 

60  CF  =  COS(ALPH) 

61  SF  =  SII(ALPH) 

62  OREAL  =  OREAL  +  PHW(K3)  ♦  CF  +  PHtf(K4)  *  SF 

63  OIMAG  =  OIMAG  +  PHW(K4)  *  CF  -  PHW(K3)  ♦  SF 

64  2000  COITIIUE 

65  C 

66  C  CPM  =  27.321582  TROPICAL  MOITH 

67  CPM  =  F  ♦  27.321582 

68  C  CPy  =  365.25  JULIAI  YEAR 

69  CPY  =  F  ♦  365.25 

70  C  lOTE  THAT  A  TROPICAL  YEAR  IS  365.24219879  FOR  THE  YEAR  1900  AID 

71  C  SHOULD  HAVE  .00000600  SUBTRACTED  FOR  EACH  CEITURY  AFTER  1900. 

72  R  =  SQRT(0REAL**2  0IMAG**2) 

73  PSI  =  ATAI2( OIMAG, OREAL)  *  57.29578 

74  FMAX  =  F  +  DELF/2. 

75  FMII  =  FMAX  -  DELF 

76  C 

77  C  PICK  THE  DARVII  SYMBOL  AID  FREQUEICY  OF  BOTH  THE  MOST  CEITRAL 

78  C  LIIE  AID  THE  MOST  SIGIIFICAIT  LIIE  COITAIIED  II  AIY  BAID 

79  C  F  PLUS  OR  MIIUS  DELF.  SIGIIFICAICE  IS  TAKEI  TO  BE  THAT  IMPLIED 

80  C  BY  THE  ORDERIIG  OF  THE  LUES  II  THE  HARMOIIC  COISTAITS  TABLES 

81  C  OF  THE  IITERIATIOIAL  HYDROGRAPHIC  BUREAU  (MOIACO) ,  WITH 

82  C  SPECIES  IITERSPERSED. 

83  C 

84  C  SET  DIFF  =  LARGE  HUMBER 

85  DIFF  =10. ♦•35 

86  JIEAR  =  50 

87  JSIG=50 

88  C 

89  DO  2200  J=1,4B 

90  IF(FRBq(J)  .GT.  FMAX)  GO  TO  2200 

91  IF(FREQ(J)  .LT.  FMII)  GO  TO  2200 

92  JSIG  =  J 

93  T  =  ABS(F  -  FREQ(J)) 

94  IF(T  .GT.  DIFF)  GO  TO  2200 

95  DIFF  =  T 

96  JIEAR  =  J 

97  2200  COITIIUE 

98  C 

99  IF( JIEAR  .EQ.  SO)  GO  TO  3400 

100  PRUT  22.  CPY, CPM, F, OREAL, OIMAG, R, PSI, KSYMBC JSIG), FREQ(JSIG), 

101  1  KSYMBC JIEAR). FREq(JIEAR) 
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102 

103 

104 
108 
106 

107 

108 
109 

no 

111 

112 

113 

114 
118 

1 

2 

3 

4 
8 
6 

7 

8 
9 

10 

11 

12 

13 

14 
18 
16 

17 

18 

19 

20 
21 
22 

23 

24 
28 
26 

27 

28 

29 

30 

31 

32 

33 

34 
36 

36 

37 

38 

39 

40 


22  F0IIMAT(1H0,F10.3,F10.4.F11.6.F13.6.F12.6,F13.6.F10.3, 

1  2(6X,A7,F6.4,2X)) 

2400  IF(KEEP  .EQ.  0)  GO  TO  2800 
ORAY(Il)  =  OREAL 
0RAY(I2)  =  OIMAG 
2600  F  =  F  +  DELF 
3000  COITIIUE 
C 

TADM  =  0. 

PRUT  4 
RETURI 

3400  PRUT  2, CPY.CPH.F, OREAL  .OIMAG  ,R,PSI.KSYMB(JSIG) .KSYNB(JIEAR) 
GO  TO  2400 
EID 

SUBROUTIIE  HG ( ORAY . LO . nCOIST . IRC . NORDER . ITYPE) 

C 

C  TITLE  -  HG 

C  COMPUTES  LIIE  AMPLITUDES  II  CEITIMETERS  AID  GREEIWICH 

C  PHASE  FROM  RESPOISE  ADMITTAICES 

C  AUTHOR-  MARK  WIMBUSH  lOVA  1978 

C 

DIMEISIOI  HP0T02(2) .HP0T(2.2.2) .HP0TX3(2.3,2) ,ORAY(LO) . 

*  ICOIST(IIC) 

DATA  HP0T02/3. 1,6.663/ 

DATA  HPOT/26. 221, 36. 878, 8. 02, 12. 203, 63. 192, 7. 996, 12. 099, 29. 4/ 
DATA  HP0TX3/ 1 . 387 1 , 0 . 06969 ,0.2314,0.22144,0.66741, 

*  0.048,0.399,0.146,0.389,0.369,0.210,0.766/ 


print  120 

DO  I  -  1,IIC 
IC  =  ICOISTCI) 

OREAL  =  0RAY(2*IC-1) 

OIMAG  =  0RAY(2*IC) 

R  =  SQRT(0REAL**2+0IMAG**2) 

PSI  =  ATAI2(0IMAG,0REAL)*87. 29878 
G  =  AM0D(180.0*FL0AT(M0RDER)-PSI, 360.0) 

IF  (ITYPE. Eq. 10)  then 
J  =  1 

IF  (ICOIST(l).Eq.l)  J  =  2 
H  =  ReBPOTd.J.MOROER) 

•lac  IF  (ITYPE. EQ. -10)  then 
H  =  ReHP0T02(I) 

else 

IF  (ITYPE. GT.O)  then 
1  =  2 
J  =  ITYPE 

•lac 

1  =  1 

J  =  1 -ITYPE 
•ndif 

H  =  ReHP0TX3(I,J.I) 

•ndif 


Ml 


41 

42 

print  160,IC,H,G 

43 

•nddo 

44 

46 

46 

RETURI 

47 

48 

120 

F0mT(’0',18I,  'H‘,20X.  *G') 

49 

160 

FORMAK'O*  ,1X.I3.F20.6,F20.3) 

60 

61 

EID 

142 


3.9  FILTER-NAMES.M 

1  y^**^^^***tm*****m**************************************** 

2  y,  f  iltsr.nanes 

3  y. 

4  %  filters  the  ies  records  specified  in  the  file  naaes.a 

6  y,  24-Jan-1990 

7  %  enter  the  file  naaes,  bints  and  filter  coefficents  from  quasi-control 

8  %  file  naaes.a. 

9  y. 

10  %  z  =  array  of  seacor  file  prefixes 

11  %  bints  -  vector  containing  B-intercepts 

L2  y,  b,a  ~  bnttersorth  filter  coefficents,  as  in  signal  processing  tool  box 

13  y,  docuaentation,  or  'help  butter’  in  Matlab 

14  y. 


echo  off 


for  i=l ;length(bint8) 


%  get  z, bints, b,  and  a 
7,  loop  through  all  files 


evaKC’load  ’  ,z(i seacor ’] )  7,  load  file.  Eval(t)  is  a  text  macro 

7,  faciltiy.  It  causes  text  string  in 
%  t  to  be  interpreted  as  a  aatlab 
7,  coaaand  or  expression,  ’help  eval’ 

7,  or  3-39  in  the  manual. 


evaKC’y  =  ’  ,z(i, ,2) ;’]  ) 
eval([’t  =  ’,z(i, 4);’]) 

k  =  raapf (y) ; 
y  =  y  -  k; 

y  =  f ilter(b,a,y) ; 


7,  assign  travel  tiaes  to  vector  y 
y.  assign  time  to  vector  t 

%  remove  ramp  (line  froa  first  to  last 
%  point)  not  a  Matlab  m-file 

7,  filter  foruio-d.  See  3-47  in  Matlab 
7,  a2uiual  or  ’help  filter’ 


y  =  flipxCf ilter(b,a,flipx(y)))  ;  7,  filter  backueurds.  flipx  flips  a 

7,  matrix  about  the  x  axis,  here  it 
%  is  used  to  reverses  the  order  of  a 

7,  column  vector  (and  sill  do  nothing  to  a 
%  rov  vector),  also  see  flipy. 


J  =  y  +  k; 


%  return  ramp 


y  =  y(41;length(y)-40); 
t  =  t(41:length(t)-40) ; 

Csy.st]  =  8ubsaaple(y,t) ; 


%  remove  regions  with  possible 
7,  transient  ringing 

7,  subsaaple  at  even  6  hourly 
X  increments,  not  a  Matlab  m-file 


sy=-19800*8y  +  bints(i)*one8(length(sy) ,1) ; 

X  calibrate  to  Z_12  depth.  oaes(n,a) 
X  creates  a  nxm  matrix  of  ones .  3-89 


113 


53 

54  q  =  [at.sy];  %  sava  to  aat  file 

55  aval([’sav#  ’ ,z(i, : ) , ’ .zlSstar  q  /ascii*]) 

56  eval(  C’clseur  ’z(i,^)]) 

57  end  %  end  for  loop 

58 
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A  COMMAND  PROCEDURES 

Most  of  the  lES  processing  programs  are  not  interactive,  and  a  VMS  command  procedure  is  usually 
used  to  associate  the  programs  logical  units  with  the  proper  input  and  output  files. 

An  example  command  procedure  is  listed  below.  This  procedure  assigns  all  the  necessary  files 
to  logical  units  and  runs  MEMOD.  By  defining  FOR005  to  be  [.ctrlj’pl’.ctrl  the  logical  unit  5  is 
then  defined  to  be  the  control  file  (here  pi  is  a  parameter  passed  to  the  procedure  at  the  command 
line).  For  example,  <@MEMOD90  SN078  IES90H1  calls  the  procedure  below  and  passes  'SN078’  and 
‘IES90Hr  as  the  parameters  PI  and  P2. 

$! 

$!  MEM0D90.COM 

Comnand  file  for  running  the  meaod  program  on  a  specific  data  set 

$! 

$!  mPUT/OUTPUT  UIITS  USED: 

$!  KR  (UIIT  6)  -  COITROL  IIPUT 
$!  KW  (UIIT  6)  -  LOG  OUTPUT 

$!  KWDA  (UIIT  7)  -  TTl  MODE/MEDIAI  DISK  OUTPUT  DATASET 

$!  KTOB  (UIIT  8)  -  TT2  MODE/MEDIAI  DISK  OUTPUT  DATASET 

$•  KWLA  (UIIT  9)  -  TTl  LISTIIG  OF  STATISTICS 

$!  KWLB  (UIIT  10)  -  TT2  LISTIIG  OF  STATISTICS 

$!  KRBUIS  (UIIT  11)  -  IITEGER  IIPUT  OF  BUIS  DATA 
l! 

$  DEFIIE  F0R006  [. Ctrl] ’pi CTRL 
i  DEFIIE  F0R006  ’ p2 ‘ . MEMOD.LOG 
$  DEFIIE  F0R007  ’p2’_TTl .mode 
t  DEFIIE  F0R008  ’ p2 * _TT2 . Mode 
$  DEFIIE  F0R009  'p2’_TTl.LIST 
$  DEFIIE  FOROlO  ’p2'_TT2.LIST 
I  DEFIIE  FOROll  [cruise .data. ies] 'pi ’. BUIS 
I  RUI  MEMOD. jul89 
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B  MASS  PRODUCTION 

The  time  required  to  process  large  numbers  of  lESs  can  be  shortened  by  writing  code  which  creates 
the  control  file  from  the  minimum  of  information  necessary.  Much  of  the  information  that  is  in  the 
control  files  is  the  same  for  all  the  instruments  in  a  deployment;  this  information  can  be  set  once 
within  DATA  statements  of  this  ‘driver’  program,  while  the  variable  information  can  be  condensed 
to  a  single  line  of  a  ‘list’  file.  The  programs  PUNS,  FILL,  DETIDE,  and  SEACOR  are  run  by 
‘drivers’  in  this  fashion. 

Below  is  an  example  of  an  input  list  file  for  a  SEACOR  driver  program  (which  is  also  listed 
below).  A  row  of  stars  separates  the  header  from  the  data.  All  lines  above  the  row  of  stars  are 
ignored.  For  each  line  read  below  the  stars,  the  program  writes  a  control  file  and  then  calls  a 
command  procedure  that  runs  SEACOR. 


list  for  seacor.bash 

inatmaant,  aita.  typaCp  for  praaaura).  nuabar  of  racorda,  nuabar 

of  yaara  apaonad  for  tha  tiaa  aariaa,  laap  yaaur?(YE  or  10),  ditto,  cruisa 

nuabar 

azaaplaa  froa  0C207: 

66  12  P  17016  2  YE  10  207 
37  J2  17019  2  YE  10  207 

starting  an216 
F3  and  B2  vara  lost 

a«a**«*««*«*a4>«aa*«**«*** *****«**«*•«*••**«****«•** 


67 

A2 

18687 

2 

10 

10 

216 

37 

FI 

21169 

2 

10 

10 

216 

62 

F2 

17798 

2 

10 

10 

216 

37 

G1 

21616 

2 

10 

10 

216 

67 

G2 

P 

21136 

2 

10 

10 

216 

66 

G3 

P 

21462 

2 

10 

10 

216 

76 

G4 

20064 

2 

10 

10 

216 

44 

HI 

21077 

2 

10 

10 

216 

71 

H2 

P 

17316 

2 

10 

10 

216 

63 

H3 

P 

17526 

2 

10 

10 

216 

It  is  simple  to  process  one  or  many  files.  In  this  example  10  files  are  processed.  After  processing 

these  ten,  a  new  lES  record  can  be  processed  by  relocating  the  row  of  stars  to  the  last  line  and 

adding  the  new  lES  information  beneath  it.  All  the  previously  processed  lines  are  incorporated  into 

the  header  and  consequently  excluded. 

The  program  that  uses  the  file  above  is  listed  here  as  an  example. 

1  C*** 

2  C***  lav  prograa  naad  to  ganarata  control  filav  for  and  run  aaacor 

3  C***  naaa  »  a  string  usad  to  subait  tha  coaaand  procadura  call  to  DCL 

4  C***  filanaaas  string  usad  to  ganarata  control  fila  naaas 

6  C***  fila  ^  string  usadto  ganarata  tha  fila  suffix  is.  ias90b6_216.  This 


119 


6  C***  string  is  used  in  naae. 

7  C***  haadr  -  nssd  lor  ths  hsadsr  card  of  the  control  fils 

8  C***  . . . 

9  C*** 

10  charactsrs60  naas.filsnaas.fila 

11  charactara60  haadr 

12  charactaraS  cruisa 

13  charactara2  sita.instr ,yaano(2) 

14  charactar*!  typa 

15  intsgsr  racs.yaarspan, status, libtspavn.siza.strftria 

16  logical  azist 

17 

18  Caaa* 

19  c***a  Gat  tha  fila  naaa  (naaa)  of  fila  containing  all  tha  partinant 

20  C****  inforaation  to  aaka  tha  control  fila.  This  consists  of: 

21  Caaa*  Tha  instruaant  sarial  nuabar,  sita,  typa  of  instruaant  (prassura 

22  C****  or  not),  tha  total  nuabar  of  records,  tha  length  of  tha  record, 

23  C****  tha  nuabar  of  years  spanned  by  tha  record,  shathar  or  no  tha  year 

24  Case*  was  a  leap  one,  ditto,  tha  cruisa  nuabar 

25  Caaa* 

26  Caaa*  fortran  azprassad  as  instr,  sita,  typa,  rocs,  yaarspam,  ya8no(2), 

27  c****  cruisa. 

28  C**** 

29  C**** 

30  C****  Tha  fila  has  a  header.  A  row  of  stars  indicates  that  tha  next  line  is 

31  Caaaa  data  containing  tha  above  entries. 

32  c**** 

33 

34 

35  2  srita(5,*)  ’input  fila  naaa:’ 

36  read(5,fBt=’(q,i}’)  naaa.siza,  naaeCl ;naBa.8iza) 

37  inquire(f ila=naaa(l :naBa_8iza) ,  axi8t=azi8t) 

38 

39  if  (exist)  than 

40  opan(unit=19,f ile=naaa(l :naBa_8iza) ,forB= ’formatted' ,Btatu8='old’) 

41  else 

42  type*,  ’file  not  found.’ 

43  goto  2 

44  endif 

45 

46  1  raad(19,fat=' (q,A) ’)  naBa_aizo,naaa(l :naaa_siza) 

47  if  (named :  1)  .na. ’*’ )  goto  1 

48 

49  3  raad(19,100,and«200) 

50  /  instr, site, typa, race, yaarspan.yasno, cruisa 

51  100  format(a2,x,a2,x,al,x,i5,x,il,x,a2,z,a2,x,a3) 

52 

83  C****** 

54  c******  create  fila  naaa,  open  it,  and  vrita  appropriate  cards  for 

56  c******  tha  given  control  file  flag. 

66  C****** 

57  filanama*’ [cruise. saacor. Ctrl] ’ 

58  fila*’ias90’ 

59  fsiza*6 
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60 

61 

62 

63 

64 

65 

66 

67 

68 

69 

70 

71 

72 

73 

74 
78 

76 

77 

78 

79 

80 
81 
82 

83 

84 
86 
86 

87 

88 

89 

90 

91 

92 

93 

94 
96 

96 

97 

98 

99 
100 
101 
102 

103 

104 
106 
106 

107 

108 


status  s  strftriB  (f ilsnaas.filanaaa.sizs) 
if  ( .not . status)  cidl  liblsignalCXvaKstatus)) 
if  ((typs.ns.'  ’) .or. (typs.sq. '  ’))  than 
f  ile=typs//L’  ias90' 
f sizs=6 

f ilenaas=f ilenaasCl :8iza)//typa 

siza=8izs+l 

andif 

c  filanaas  =  lilena»s{l:8ize)//’ia890’//8ite//'_’//crui8s//’ .Ctrl’ 
filenaas  =  filsnaBia(l:8izs)//’ia890’//8ite//’ .Ctrl’ 
c  fil8=fils(l :f8izs)//sits//’_ ’//cruise 
f ila=f ile(l:f 8ize)//8ite 

open(unit=20 , f ile=f ilenane .f orm= ’f oziiatted ’ . 8tatus= ’nes ’ ) 
headr*" ’’//site//’  SIO’//  instr//’  ’//type//’  ’//’ 

/  El ’//cruise//”” 

vrite(20, 103)  headr .recs .yearspan.yesnod) ,yasno(2) 
if  (((icharCsiteCl : 1)) . ge. 97) .and. (ichar (sited : 1)) .le.99)) .or . 

/  ((icharCsited :  1))  .ge.66)  .and.  (ichar(sited :  1))  .le.67)))  then 
vrite(20.201)  1 

else 

vrite(20,201)  3 
endif 

201  forBiat(z, ’ICARD3  region^  ’.il  >’  lend’) 

202  close (unit=20) 

Ceeee 

Ceee*  Here  naae  is  used  to  generate  a  string  that  passes  a  coaaiand 
C****  procedure  call  and  the  neccesseury  paraaeter  to  the  LIBISPAWI 
C****  routine.  LIBISPAWI  allous  the  execution  of  the  DCL  procedure 
Q****  froB  within  this  prograa. 

C**** 

C****  go.seacor  siaply  executes  seacor89.coB  and  iaprints  the  log  file 

C**** 

c  naae=’Cgo_8eacor  ’//file 
naae=’9seacor90  ’//file 
statns=lib|8pawn(naae) 

Ceeee 

C*e*«  get  next  instruaent 

Ceeee 

goto  3 

200  close(nnit=19) 

103  foraatC’  ICARDI’/’  HEADR*’a80/’  lEID’/’  ICARD2 

/  IPTS=’,i«.',  10YRS*’,il,'.  FRSTYR=  ”  '.a2,’  ”,  SCIDYR 
/  *”  ’,a2,’  ”  lEID’) 

end 
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